Released DG*5.3*697 SEQ #613 Extracted from mail message **KIDS**:DG*5.3*697^ **INSTALL NAME** DG*5.3*697 "BLD",6574,0) DG*5.3*697^REGISTRATION^0^3060510^y "BLD",6574,1,0) ^^3^3^3060130^ "BLD",6574,1,1,0) This patch disables the HL7 subscription "BLD",6574,1,2,0) control functionality, and fixes the SERVICE ENTRY DATE [LAST] (#.326) "BLD",6574,1,3,0) field display when using the Remote Patient Data Query. "BLD",6574,4,0) ^9.64PA^^ "BLD",6574,6) 3^ "BLD",6574,"ABPKG") n "BLD",6574,"KRN",0) ^9.67PA^8989.52^19 "BLD",6574,"KRN",.4,0) .4 "BLD",6574,"KRN",.401,0) .401 "BLD",6574,"KRN",.402,0) .402 "BLD",6574,"KRN",.403,0) .403 "BLD",6574,"KRN",.5,0) .5 "BLD",6574,"KRN",.84,0) .84 "BLD",6574,"KRN",3.6,0) 3.6 "BLD",6574,"KRN",3.8,0) 3.8 "BLD",6574,"KRN",9.2,0) 9.2 "BLD",6574,"KRN",9.8,0) 9.8 "BLD",6574,"KRN",9.8,"NM",0) ^9.68A^4^3 "BLD",6574,"KRN",9.8,"NM",2,0) VAFCTFU^^0^B41840382 "BLD",6574,"KRN",9.8,"NM",3,0) VAFCTFMF^^0^B23249267 "BLD",6574,"KRN",9.8,"NM",4,0) VAFCPDT2^^0^B21679490 "BLD",6574,"KRN",9.8,"NM","B","VAFCPDT2",4) "BLD",6574,"KRN",9.8,"NM","B","VAFCTFMF",3) "BLD",6574,"KRN",9.8,"NM","B","VAFCTFU",2) "BLD",6574,"KRN",19,0) 19 "BLD",6574,"KRN",19.1,0) 19.1 "BLD",6574,"KRN",101,0) 101 "BLD",6574,"KRN",409.61,0) 409.61 "BLD",6574,"KRN",771,0) 771 "BLD",6574,"KRN",870,0) 870 "BLD",6574,"KRN",8989.51,0) 8989.51 "BLD",6574,"KRN",8989.52,0) 8989.52 "BLD",6574,"KRN",8994,0) 8994 "BLD",6574,"KRN","B",.4,.4) "BLD",6574,"KRN","B",.401,.401) "BLD",6574,"KRN","B",.402,.402) "BLD",6574,"KRN","B",.403,.403) "BLD",6574,"KRN","B",.5,.5) "BLD",6574,"KRN","B",.84,.84) "BLD",6574,"KRN","B",3.6,3.6) "BLD",6574,"KRN","B",3.8,3.8) "BLD",6574,"KRN","B",9.2,9.2) "BLD",6574,"KRN","B",9.8,9.8) "BLD",6574,"KRN","B",19,19) "BLD",6574,"KRN","B",19.1,19.1) "BLD",6574,"KRN","B",101,101) "BLD",6574,"KRN","B",409.61,409.61) "BLD",6574,"KRN","B",771,771) "BLD",6574,"KRN","B",870,870) "BLD",6574,"KRN","B",8989.51,8989.51) "BLD",6574,"KRN","B",8989.52,8989.52) "BLD",6574,"KRN","B",8994,8994) "BLD",6574,"QUES",0) ^9.62^^ "BLD",6574,"REQB",0) ^9.611^4^3 "BLD",6574,"REQB",2,0) DG*5.3*520^1 "BLD",6574,"REQB",3,0) DG*5.3*428^1 "BLD",6574,"REQB",4,0) DG*5.3*627^1 "BLD",6574,"REQB","B","DG*5.3*428",3) "BLD",6574,"REQB","B","DG*5.3*520",2) "BLD",6574,"REQB","B","DG*5.3*627",4) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 697^3060510^100850 "PKG",5,22,1,"PAH",1,1,0) ^^3^3^3060510 "PKG",5,22,1,"PAH",1,1,1,0) This patch disables the HL7 subscription "PKG",5,22,1,"PAH",1,1,2,0) control functionality, and fixes the SERVICE ENTRY DATE [LAST] (#.326) "PKG",5,22,1,"PAH",1,1,3,0) field display when using the Remote Patient Data Query. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") YES "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") YES "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 3 "RTN","VAFCPDT2") 0^4^B21679490^B21671798 "RTN","VAFCPDT2",1,0) VAFCPDT2 ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ; 12/3/04 3:50pm "RTN","VAFCPDT2",2,0) ;;5.3;Registration;**414,505,627,697**;Aug 13, 1993 "RTN","VAFCPDT2",3,0) ;Reference to ^MPIF(984.9,"C" supported by IA #3298 "RTN","VAFCPDT2",4,0) ; "RTN","VAFCPDT2",5,0) CMORHIS ;Find CMOR History "RTN","VAFCPDT2",6,0) I '$O(^DPT(DFN,"MPICMOR",0)) G CMORCHG "RTN","VAFCPDT2",7,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",8,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",9,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",10,0) D CHISHDR "RTN","VAFCPDT2",11,0) S HIS=0 F S HIS=$O(^DPT(DFN,"MPICMOR",HIS)) Q:'HIS D Q:QFLG "RTN","VAFCPDT2",12,0) .S DIC=2,DR="993",DR(2.0993)=".01;3",DA=DFN,DA(2.0993)=HIS "RTN","VAFCPDT2",13,0) .S DIQ(0)="E",DIQ="CMORNODE" "RTN","VAFCPDT2",14,0) .D EN^DIQ1 K DIC,DR,DA,DIQ "RTN","VAFCPDT2",15,0) .S HISCMOR=$G(CMORNODE(2.0993,HIS,.01,"E")) "RTN","VAFCPDT2",16,0) .I +HISCMOR S HISCMOR=$$GET1^DIQ(4,HISCMOR,.01) "RTN","VAFCPDT2",17,0) .S CHGDT=$G(CMORNODE(2.0993,HIS,3,"E")) "RTN","VAFCPDT2",18,0) .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",19,0) ..S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",20,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CHISHDR "RTN","VAFCPDT2",21,0) .W !,$P(CHGDT,"@"),?12," - CMOR changed from ",HISCMOR "RTN","VAFCPDT2",22,0) ; "RTN","VAFCPDT2",23,0) CMORCHG ;Find CMOR change request "RTN","VAFCPDT2",24,0) I '$O(^MPIF(984.9,"C",DFN,0)) G EXT "RTN","VAFCPDT2",25,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",26,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",27,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",28,0) D CCHGHDR "RTN","VAFCPDT2",29,0) S CHG=0 F S CHG=$O(^MPIF(984.9,"C",DFN,CHG)) Q:'CHG D Q:QFLG "RTN","VAFCPDT2",30,0) .S DIC=984.9,DA=CHG,DR=".01;.03;.06;.07;.08;1.03",DIQ="CHGNODE" "RTN","VAFCPDT2",31,0) .S DIQ(0)="EI" D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDT2",32,0) .S CHGNUM=$G(CHGNODE(984.9,CHG,.01,"E")) "RTN","VAFCPDT2",33,0) .S CHGDT=$G(CHGNODE(984.9,CHG,.03,"E")) "RTN","VAFCPDT2",34,0) .S TMSG=$G(CHGNODE(984.9,CHG,.08,"E")) "RTN","VAFCPDT2",35,0) .S TREQ=$G(CHGNODE(984.9,CHG,1.03,"E")) "RTN","VAFCPDT2",36,0) .S SITE=$G(CHGNODE(984.9,CHG,.07,"E")) "RTN","VAFCPDT2",37,0) .S STATUS=$G(CHGNODE(984.9,CHG,.06,"E")) "RTN","VAFCPDT2",38,0) .I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",39,0) ..S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",40,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CCHGHDR "RTN","VAFCPDT2",41,0) .W !,"REQUEST #",CHGNUM," - ",TMSG," ",CHGDT "RTN","VAFCPDT2",42,0) .W !?4,"Type of Request: ",TREQ," ",SITE "RTN","VAFCPDT2",43,0) .W !?4,"Status : ",STATUS,! "RTN","VAFCPDT2",44,0) ; "RTN","VAFCPDT2",45,0) EXT ;Extended patient demographic data "RTN","VAFCPDT2",46,0) I $E(IOST,1,2)="C-" D Q:QFLG "RTN","VAFCPDT2",47,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",48,0) .W @IOF "RTN","VAFCPDT2",49,0) I QFLG=1 G QUIT^VAFCPDAT "RTN","VAFCPDT2",50,0) W !!,"Additional DPT Data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",51,0) S DA=DFN,DIC=2,DIQ="XDATA",DIQ(0)="EI" "RTN","VAFCPDT2",52,0) S DR=".05;.08;.092;.093;.219;.2401;.2402;.2403;.211;.302;.323;.341;.331;.361;1901;.325;.328;.326;.327;.097;.525" "RTN","VAFCPDT2",53,0) N COB,SOB,FNM,MNM,MMNM,NOK,NOKN,DESIG,EMER,ELIG,VET,SRVBR,SRVNUM,SRVEDT,SRVSDT,SRVCPCT,POSRVC,FILEDT,MARS,RELP,POW "RTN","VAFCPDT2",54,0) D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDT2",55,0) S COB=$G(XDATA(2,DFN,.092,"E")),SOB=$G(XDATA(2,DFN,.093,"E")) "RTN","VAFCPDT2",56,0) S FILEDT=$G(XDATA(2,DFN,.097,"E")),FNM=$G(XDATA(2,DFN,.2401,"E")) "RTN","VAFCPDT2",57,0) S MNM=$G(XDATA(2,DFN,.2402,"E")),MMNM=$G(XDATA(2,DFN,.2403,"E")) "RTN","VAFCPDT2",58,0) S NOK=$G(XDATA(2,DFN,.211,"E")),DESIG=$G(XDATA(2,DFN,.341,"E")) "RTN","VAFCPDT2",59,0) S EMER=$G(XDATA(2,DFN,.331,"E")) "RTN","VAFCPDT2",60,0) S ELIG=$G(XDATA(2,DFN,.361,"E")),VET=$G(XDATA(2,DFN,1901,"E")) "RTN","VAFCPDT2",61,0) S SRVBR=$G(XDATA(2,DFN,.325,"E")),SRVNUM=$G(XDATA(2,DFN,.328,"E")) "RTN","VAFCPDT2",62,0) S SRVEDT=$G(XDATA(2,DFN,.326,"E")),SRVSDT=$G(XDATA(2,DFN,.327,"E")) "RTN","VAFCPDT2",63,0) S MARS=$G(XDATA(2,DFN,.05,"E")),RELP=$G(XDATA(2,DFN,.08,"E")) "RTN","VAFCPDT2",64,0) S POSRVC=$G(XDATA(2,DFN,.323,"E")),SRVCPCT=$G(XDATA(2,DFN,.302,"E")) "RTN","VAFCPDT2",65,0) S NOKN=$G(XDATA(2,DFN,.219,"E")),POW=$G(XDATA(2,DFN,.525,"E")) "RTN","VAFCPDT2",66,0) ; "RTN","VAFCPDT2",67,0) W !,"PLACE OF BIRTH [CITY]",?31,": ",COB "RTN","VAFCPDT2",68,0) W !,"PLACE OF BIRTH [STATE]",?31,": ",SOB "RTN","VAFCPDT2",69,0) W !,"FATHER'S NAME",?31,": ",FNM "RTN","VAFCPDT2",70,0) W !,"MOTHER'S NAME",?31,": ",MNM "RTN","VAFCPDT2",71,0) W !,"MOTHER'S MAIDEN NAME",?31,": ",MMNM "RTN","VAFCPDT2",72,0) W !,"NAME OF PRIMARY NEXT OF KIN",?31,": ",NOK "RTN","VAFCPDT2",73,0) W !,"NEXT OF KIN PHONE NUMBER",?31,": ",NOKN "RTN","VAFCPDT2",74,0) W !,"NAME OF DESIGNEE",?31,": ",DESIG "RTN","VAFCPDT2",75,0) W !,"EMERGENCY NAME",?31,": ",EMER "RTN","VAFCPDT2",76,0) W !,"MARITAL STATUS",?31,": ",MARS "RTN","VAFCPDT2",77,0) W !,"RELIGIOUS PREFERENCE",?31,": ",RELP "RTN","VAFCPDT2",78,0) W !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG "RTN","VAFCPDT2",79,0) W !,"VETERAN (Y/N)?",?31,": ",VET "RTN","VAFCPDT2",80,0) W !,"SERVICE BRANCH [LAST]",?31,": ",SRVBR "RTN","VAFCPDT2",81,0) W !,"SERVICE NUMBER [LAST]",?31,": ",SRVNUM "RTN","VAFCPDT2",82,0) W !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT "RTN","VAFCPDT2",83,0) W !,"SERVICE ENTRY DATE [LAST]",?31,": ",SRVEDT "RTN","VAFCPDT2",84,0) W !,"SERVICE SEPARATION DATE [LAST]",?31,": ",SRVSDT "RTN","VAFCPDT2",85,0) W !,"PERIOD OF SERVICE",?31,": ",POSRVC "RTN","VAFCPDT2",86,0) W !,"POW STATUS INDICATED?",?31,": ",POW "RTN","VAFCPDT2",87,0) W !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT "RTN","VAFCPDT2",88,0) ; "RTN","VAFCPDT2",89,0) D DEM^VADPT "RTN","VAFCPDT2",90,0) ;ETHNICITY info "RTN","VAFCPDT2",91,0) I $G(VADM(11,1)) W !,"ETHNICITY INFORMATION",?31,": ",$P(VADM(11,1),"^",2) "RTN","VAFCPDT2",92,0) ; "RTN","VAFCPDT2",93,0) ;RACE multiple "RTN","VAFCPDT2",94,0) I $O(VADM(12,0)) D "RTN","VAFCPDT2",95,0) .W !,"RACE INFORMATION (multiple):" "RTN","VAFCPDT2",96,0) .S RACEMUL=0 F S RACEMUL=$O(VADM(12,RACEMUL)) Q:'RACEMUL W !?3,$P(VADM(12,RACEMUL),"^",2) "RTN","VAFCPDT2",97,0) ; "RTN","VAFCPDT2",98,0) ;ALIAS multiple "RTN","VAFCPDT2",99,0) I $O(^DPT(DFN,.01,0)) D "RTN","VAFCPDT2",100,0) .W !,"ALIAS (multiple):" "RTN","VAFCPDT2",101,0) .S ALIAS=0 F S ALIAS=$O(^DPT(DFN,.01,ALIAS)) Q:'ALIAS W !?3,$E($P(^DPT(DFN,.01,ALIAS,0),"^"),1,30),?35,"SSN: "_$P($G(^DPT(DFN,.01,ALIAS,0)),"^",2) "RTN","VAFCPDT2",102,0) ; "RTN","VAFCPDT2",103,0) K ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM "RTN","VAFCPDT2",104,0) Q "RTN","VAFCPDT2",105,0) ; "RTN","VAFCPDT2",106,0) CHISHDR W !!,"CMOR History:",!,"--------------" "RTN","VAFCPDT2",107,0) Q "RTN","VAFCPDT2",108,0) CCHGHDR W !!,"CMOR Change Request History:",!,"----------------------------" "RTN","VAFCPDT2",109,0) Q "RTN","VAFCTFMF") 0^3^B23249267^B25920957 "RTN","VAFCTFMF",1,0) VAFCTFMF ;ALB/JLU,LTL-Broadcast Master File Update for Treating Facility ;09/03/98 "RTN","VAFCTFMF",2,0) ;;5.3;Registration;**149,261,255,307,361,428,697**;Aug 13, 1993 "RTN","VAFCTFMF",3,0) ; "RTN","VAFCTFMF",4,0) ;Reference to ^ORD(101 supported by IA #872 "RTN","VAFCTFMF",5,0) BCKTFMFU ; "RTN","VAFCTFMF",6,0) ;This entry point is used to generate a Master File update "RTN","VAFCTFMF",7,0) ;for each patient that is in the "AXMIT" cross reference in the PIVOT "RTN","VAFCTFMF",8,0) ;file. "RTN","VAFCTFMF",9,0) ;INPUTS NONE "RTN","VAFCTFMF",10,0) ;OUTPUTS Sending of MFU messages "RTN","VAFCTFMF",11,0) ; "RTN","VAFCTFMF",12,0) ;IA: 2056 - $$GET1^DIQ "RTN","VAFCTFMF",13,0) ;IA: 10106 - $$HLDATE^HLFNC "RTN","VAFCTFMF",14,0) ;IA: 2161 - INIT^HLFNC2 "RTN","VAFCTFMF",15,0) ;IA: 2164 - GENERATE^HLMA "RTN","VAFCTFMF",16,0) ;IA: 2270 - GET^HLSUB "RTN","VAFCTFMF",17,0) ;IA: 2701 - $$GETICN/$$HL7CMOR/$$IFVCCI^MPIF001 "RTN","VAFCTFMF",18,0) ;IA: 2702 - $$MPINODE^MPIFAPI "RTN","VAFCTFMF",19,0) ;IA: 3073 - EN1^RGADT2 "RTN","VAFCTFMF",20,0) ;IA: 2796 - EXC/STOP^RGHLLOG "RTN","VAFCTFMF",21,0) ;IA: 10141 - $$PATCH^XPDUTL "RTN","VAFCTFMF",22,0) ;IA: 2171 - $$WHAT^XUAF4 "RTN","VAFCTFMF",23,0) ; "RTN","VAFCTFMF",24,0) ;quit if CIRN is not installed "RTN","VAFCTFMF",25,0) N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFMF",26,0) N PDFN,LP,EVTDATE,EVTR,SUBSCN,VAFCMPI "RTN","VAFCTFMF",27,0) I '$D(^VAT(391.71,"AXMIT",5)) G BCKQ "RTN","VAFCTFMF",28,0) F LP=0:0 S LP=$O(^VAT(391.71,"AXMIT",5,LP)) Q:'LP D "RTN","VAFCTFMF",29,0) .S PDFN=$P($G(^VAT(391.71,LP,0)),U,3) "RTN","VAFCTFMF",30,0) .I PDFN="" D EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$G(LP)) D STOP^RGHLLOG(1) Q ; log exception "RTN","VAFCTFMF",31,0) .I PDFN'=""&'$D(^DPT(PDFN,0)) D EXC^RGHLLOG(212,"Unable to send TF update due to unknown patient for IEN#"_$G(LP)) D STOP^RGHLLOG(1) Q ; log exception "RTN","VAFCTFMF",32,0) .;making sure that your site is added or updated before continuing, FILE will also add CMOR "RTN","VAFCTFMF",33,0) . I '$$PATCH^XPDUTL("RG*1.0*4") D FILE^VAFCTFU(PDFN,+$$SITE^VASITE,1) "RTN","VAFCTFMF",34,0) .S SUBSCN=$$MPINODE^MPIFAPI(PDFN) I +$G(SUBSCN)<1 D XMITFLAG^VAFCDD01(LP,0,1) Q "RTN","VAFCTFMF",35,0) .; if no subscribers (piece 5) and no CMOR (piece 3), turn off xmit flag for Pivot file. "RTN","VAFCTFMF",36,0) .I +$P(SUBSCN,"^",3)<1,(+$P(SUBSCN,"^",5)<1) D XMITFLAG^VAFCDD01(LP,0,1) "RTN","VAFCTFMF",37,0) .;Removed section to create a new subscription as it is no longer used. "RTN","VAFCTFMF",38,0) .;1/23/06 "RTN","VAFCTFMF",39,0) .I +$P($G(SUBSCN),"^",5)<1 D XMITFLAG^VAFCDD01(LP,0,1) Q "RTN","VAFCTFMF",40,0) .K HLL D GET^HLSUB($P(SUBSCN,"^",5),"","VAFC MFU-TFL CLIENT",.HLL) I '$D(HLL("LINKS")) D XMITFLAG^VAFCDD01(LP,0,1) Q "RTN","VAFCTFMF",41,0) .K HLL "RTN","VAFCTFMF",42,0) .;Update last treatment date and event reason "RTN","VAFCTFMF",43,0) .I $$PATCH^XPDUTL("RG*1.0*4") D EN1^RGADT2(PDFN,1) "RTN","VAFCTFMF",44,0) .I PDFN DO "RTN","VAFCTFMF",45,0) ..K VAFCERR "RTN","VAFCTFMF",46,0) ..I $D(^DGCN(391.91,"APAT",PDFN)) D TFMFU(PDFN) "RTN","VAFCTFMF",47,0) ..;CALL TAG TO FLIP TRANSMIT FIELD IN VAT(391.71 "RTN","VAFCTFMF",48,0) ..D:$G(RESLT) XMITFLAG^VAFCDD01(LP,0,1) "RTN","VAFCTFMF",49,0) ..;store resulting message in ADT/HL7 PIVOT file "RTN","VAFCTFMF",50,0) ..S RESLT=$S($G(RESLT)]"":RESLT,1:$P($G(ER),U,2)) "RTN","VAFCTFMF",51,0) ..D FILERM^VAFCUTL(LP,RESLT) "RTN","VAFCTFMF",52,0) ..K ER,RESLT,VAFCERR Q "RTN","VAFCTFMF",53,0) BCKQ Q "RTN","VAFCTFMF",54,0) ; "RTN","VAFCTFMF",55,0) TFMFU(PDFN) ; "RTN","VAFCTFMF",56,0) ;sends a MFU message for a single patient "RTN","VAFCTFMF",57,0) N HLEID "RTN","VAFCTFMF",58,0) S ER=$$INIT "RTN","VAFCTFMF",59,0) I ER G TFMFUQ "RTN","VAFCTFMF",60,0) D BLDTFMFU(PDFN) "RTN","VAFCTFMF",61,0) ;if error from build don't send "RTN","VAFCTFMF",62,0) I '$D(VAFCERR) D SEND "RTN","VAFCTFMF",63,0) D KILLHL7 "RTN","VAFCTFMF",64,0) TFMFUQ Q "RTN","VAFCTFMF",65,0) ; "RTN","VAFCTFMF",66,0) INIT() ; "RTN","VAFCTFMF",67,0) ;initialize HL7 variables "RTN","VAFCTFMF",68,0) S ER=0 "RTN","VAFCTFMF",69,0) S HLEID=+$O(^ORD(101,"B","VAFC MFU-TFL SERVER",0)) "RTN","VAFCTFMF",70,0) I 'HLEID S ER="1^Unable to initialize HL7 variables - Protocol not found." G INITQ "RTN","VAFCTFMF",71,0) S HL="" "RTN","VAFCTFMF",72,0) D INIT^HLFNC2(HLEID,.HL) "RTN","VAFCTFMF",73,0) I $O(HL(""))="" S ER="1^"_$P(HL,U,2) G INITQ "RTN","VAFCTFMF",74,0) I $G(HL)]"" S ER=$G(HL) "RTN","VAFCTFMF",75,0) INITQ Q ER "RTN","VAFCTFMF",76,0) ; "RTN","VAFCTFMF",77,0) ; "RTN","VAFCTFMF",78,0) BLDTFMFU(PDFN) ; "RTN","VAFCTFMF",79,0) ;builds the segments and formats the HL7 MFU message "RTN","VAFCTFMF",80,0) N CTR,INST,ICN,INSTNUM,IEN,TF,EC,INSTNAM,PPF,CMOR "RTN","VAFCTFMF",81,0) S PPF=$$IFVCCI^MPIF001(PDFN) "RTN","VAFCTFMF",82,0) S EC=$E(HL("ECH"),1,1) "RTN","VAFCTFMF",83,0) S CTR=1 "RTN","VAFCTFMF",84,0) S TFMF(1)="TFL",TFMF(2)="",TFMF(3)=$S(PPF>0:"REP",1:"UPD"),TFMF(4)="",TFMF(5)="",TFMF(6)="NE" "RTN","VAFCTFMF",85,0) S CMOR=$$HL7CMOR^MPIF001(PDFN,EC) "RTN","VAFCTFMF",86,0) I CMOR'>0 K CMOR "RTN","VAFCTFMF",87,0) S HLA("HLS",CTR)=$$EN^VAFHLMFI(HL("ECH"),HL("FS"),HL("Q"),"TFMF")_HL("FS")_$G(CMOR) "RTN","VAFCTFMF",88,0) K TFMF "RTN","VAFCTFMF",89,0) S ICN=$$GETICN^MPIF001(PDFN) "RTN","VAFCTFMF",90,0) S TFMF(1)="MAD",TFMF(2)="" "RTN","VAFCTFMF",91,0) I PPF>0 DO "RTN","VAFCTFMF",92,0) .F INST=0:0 S INST=$O(^DGCN(391.91,"APAT",PDFN,INST)) Q:'INST S IEN=$O(^(INST,0)),TF=^DGCN(391.91,IEN,0) DO "RTN","VAFCTFMF",93,0) ..S INSTNAM=$$WHAT^XUAF4(+$P(TF,U,2),.01) "RTN","VAFCTFMF",94,0) ..S INSTNUM=$$WHAT^XUAF4(+$P(TF,U,2),99) "RTN","VAFCTFMF",95,0) ..S TFMF(3)=$$HLDATE^HLFNC($P(TF,U,3)) "RTN","VAFCTFMF",96,0) ..S TFMF(4)=INSTNUM_EC_INSTNAM_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA" "RTN","VAFCTFMF",97,0) ..D SETMFE "RTN","VAFCTFMF",98,0) ..D SETZET(IEN) "RTN","VAFCTFMF",99,0) ..Q "RTN","VAFCTFMF",100,0) E DO ;NOT THE PRIMARY FACILITY "RTN","VAFCTFMF",101,0) .S INSTNAM=$$SITE^VASITE(),INST=+INSTNAM "RTN","VAFCTFMF",102,0) .S IEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0)) "RTN","VAFCTFMF",103,0) .;if there was a subscription but no TF add it, quit and don't send "RTN","VAFCTFMF",104,0) .I +IEN'>0 D FILE^VAFCTFU(PDFN,INST,1) S VAFCERR=1 Q "RTN","VAFCTFMF",105,0) .S TF=$G(^DGCN(391.91,IEN,0)) "RTN","VAFCTFMF",106,0) .S TFMF(3)=$$HLDATE^HLFNC($P(TF,"^",3)) "RTN","VAFCTFMF",107,0) .S TFMF(4)=$P(INSTNAM,U,3)_EC_$P(INSTNAM,U,2)_EC_"VA"_EC_+ICN_EC_"ICN"_EC_"VA" "RTN","VAFCTFMF",108,0) .D SETMFE "RTN","VAFCTFMF",109,0) .D SETZET(IEN) "RTN","VAFCTFMF",110,0) .Q "RTN","VAFCTFMF",111,0) BLDTFMFQ K TFMF "RTN","VAFCTFMF",112,0) Q "RTN","VAFCTFMF",113,0) ; "RTN","VAFCTFMF",114,0) SETMFE S CTR=CTR+1 "RTN","VAFCTFMF",115,0) S HLA("HLS",CTR)=$$EN^VAFHLMFE(HL("ECH"),HL("FS"),HL("Q"),"TFMF") "RTN","VAFCTFMF",116,0) Q "RTN","VAFCTFMF",117,0) SETZET(IEN) ;Date of Last Treatment event type ZET segment "RTN","VAFCTFMF",118,0) S CTR=CTR+1 "RTN","VAFCTFMF",119,0) S HLA("HLS",CTR)="ZET"_HL("FS")_$$GET1^DIQ(391.91,+IEN_",",.07) "RTN","VAFCTFMF",120,0) Q "RTN","VAFCTFMF",121,0) ; "RTN","VAFCTFMF",122,0) SEND ; "RTN","VAFCTFMF",123,0) ;sends the MFU message "RTN","VAFCTFMF",124,0) D GENERATE^HLMA(HLEID,"LM",1,.HLRESLT,"","") "RTN","VAFCTFMF",125,0) S RESLT=$S(+HLRESLT:HLRESLT,1:$P(HLRESLT,U,3)) "RTN","VAFCTFMF",126,0) Q "RTN","VAFCTFMF",127,0) ; "RTN","VAFCTFMF",128,0) KILLHL7 ; "RTN","VAFCTFMF",129,0) ;kills off the variables from the HL7 package. "RTN","VAFCTFMF",130,0) K HL,HLA,HLECH,HLEID,HLFS,HLMTIEN,HLMTIENA,HLQ,HLRESLT,HLN,HLSAN "RTN","VAFCTFMF",131,0) Q "RTN","VAFCTFU") 0^2^B41840382^B59884823 "RTN","VAFCTFU",1,0) VAFCTFU ;ALB/JLU-UTILITIES FOR THE TREATING FACILITY FILE 391.91 ;10/10/02 15:55 "RTN","VAFCTFU",2,0) ;;5.3;Registration;**149,240,261,255,316,392,440,428,474,520,697**;Aug 13, 1993 "RTN","VAFCTFU",3,0) ; "RTN","VAFCTFU",4,0) ;Reference to EXC^RGHLLOG and STOP^RGHLLOG supported by IA #2796 "RTN","VAFCTFU",5,0) ;Reference to $$UPDATE^ MPIFAPI supported by IA #2706 "RTN","VAFCTFU",6,0) ; "RTN","VAFCTFU",7,0) ;CHKSUB & GETSCN line tags removed, patch DG*5.3*697 "RTN","VAFCTFU",8,0) ;Subscriptions are no longer used and errors are being "RTN","VAFCTFU",9,0) ;generated when attempting to add a subscription. "RTN","VAFCTFU",10,0) ; "RTN","VAFCTFU",11,0) FILETF(PAT,INST) ;programmer entry point. "RTN","VAFCTFU",12,0) ;INPUT PAT - This is the patient's ICN "RTN","VAFCTFU",13,0) ; INST - This is the IEN of the institution or Treating Facility "RTN","VAFCTFU",14,0) ;it also contains the date of treatment in FM format. It is to be "RTN","VAFCTFU",15,0) ;stored in an array structure to allow for multiple treating "RTN","VAFCTFU",16,0) ;facilities. "RTN","VAFCTFU",17,0) ; EX. X(1)=500^2960101 "RTN","VAFCTFU",18,0) ; x(2)=425^2960202 "RTN","VAFCTFU",19,0) ; "RTN","VAFCTFU",20,0) ;OUTPUT 0 (ZERO) If no errors "RTN","VAFCTFU",21,0) ; 1^error description if there was an error. "RTN","VAFCTFU",22,0) ; "RTN","VAFCTFU",23,0) N PDFN,LP,VAFCER,X "RTN","VAFCTFU",24,0) S VAFCER=0 "RTN","VAFCTFU",25,0) I '$G(PAT)!('$D(INST)) S VAFCER="1^Parameter missing." G FILETFQ "RTN","VAFCTFU",26,0) I $D(@INST)<10 S VAFCER="1^Institution array not populated." G FILETFQ "RTN","VAFCTFU",27,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ "RTN","VAFCTFU",28,0) S PDFN=$$GETDFN^MPIF001(PAT) "RTN","VAFCTFU",29,0) I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ "RTN","VAFCTFU",30,0) N FSTRG "RTN","VAFCTFU",31,0) F LP=0:0 S LP=$O(@INST@(LP)) Q:'LP D FILE(PDFN,@INST@(LP)) "RTN","VAFCTFU",32,0) ; "RTN","VAFCTFU",33,0) FILETFQ Q VAFCER "RTN","VAFCTFU",34,0) ; "RTN","VAFCTFU",35,0) ; both the SET & QUERYTF subroutines have been moved to VAFCTFU1 as "RTN","VAFCTFU",36,0) ; the result of DG*5.3*261 *261 gjc@120899 "RTN","VAFCTFU",37,0) ; "RTN","VAFCTFU",38,0) FILE(PDFN,FSTRG,TICN,VAFCSLT,ERROR) ;this module files the individual entry "RTN","VAFCTFU",39,0) ;PDFN is the patient's DFN "RTN","VAFCTFU",40,0) ;FSTRG = institution or treating facility^Date of treatment^Event reason "RTN","VAFCTFU",41,0) ;TICN - if 1 suppress add entries to ADT HL7 PIVOT (#391.71) file "RTN","VAFCTFU",42,0) ;VAFCSLT - (optional) if 1 suppress exception logging and return error in the ERROR array "RTN","VAFCTFU",43,0) ;ERROR - (optional) "RTN","VAFCTFU",44,0) ;Ex 500^2960202^A1 "RTN","VAFCTFU",45,0) ; "RTN","VAFCTFU",46,0) N X,Y "RTN","VAFCTFU",47,0) I $G(VAFCSLT)="" S VAFCSLT=0 "RTN","VAFCTFU",48,0) S X="MPIF001" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFU",49,0) S X="MPIFQ0" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFU",50,0) N TFIEN,PDLT,FAC,EVNTR,VAFCER,CMOR,ICN,STA,ECNT "RTN","VAFCTFU",51,0) S ECNT=1 "RTN","VAFCTFU",52,0) S FAC=$P(FSTRG,U,1),PDLT=$P(FSTRG,U,2),EVNTR=$P(FSTRG,U,3) "RTN","VAFCTFU",53,0) S STA=$$STA^XUAF4(FAC) "RTN","VAFCTFU",54,0) ; "RTN","VAFCTFU",55,0) I '$$FIND1^DIC(4,"","MX","`"_FAC) D Q "RTN","VAFCTFU",56,0) . I 'VAFCSLT D EXC^RGHLLOG(212,"Msg#"_$G(HL("MID"))_" unknown Institution IEN "_FAC_" passed into TF update.",PDFN) D STOP^RGHLLOG(1) Q "RTN","VAFCTFU",57,0) . I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to unknown Institution IEN "_FAC_" passed into TF update." "RTN","VAFCTFU",58,0) I PDLT'="" K %DT S %DT="T" S X=PDLT D ^%DT K %DT I Y<0 S VAFCER="1^Not a FM date." D Q "RTN","VAFCTFU",59,0) .I 'VAFCSLT D EXC^RGHLLOG(212,"TF updated in msg#"_$G(HL("MID"))_" for Institution IEN "_FAC_" but with invalid date "_PDLT_" for DFN "_PDFN,PDFN) "RTN","VAFCTFU",60,0) .I VAFCSLT S ERROR(STA)="Update of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to invalid date "_PDLT_" for DFN "_PDFN "RTN","VAFCTFU",61,0) ;removed code for adding local ICN's "RTN","VAFCTFU",62,0) S ICN=+$$MPINODE^MPIFAPI(PDFN) "RTN","VAFCTFU",63,0) S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,FAC,0)) D "RTN","VAFCTFU",64,0) .;TFIEN is used in other places so quit after adding new entry "RTN","VAFCTFU",65,0) .I 'TFIEN D FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,.ERROR) Q "RTN","VAFCTFU",66,0) .I TFIEN D FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,.ERROR) "RTN","VAFCTFU",67,0) ;look to see if CMOR is in TF list if not add "RTN","VAFCTFU",68,0) S CMOR=$$GETVCCI^MPIF001(PDFN) "RTN","VAFCTFU",69,0) S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED + "RTN","VAFCTFU",70,0) ;check to see if CMOR exist if not add it "RTN","VAFCTFU",71,0) I +$G(CMOR)>0 D:'$D(^DGCN(391.91,"APAT",PDFN,CMOR)) FILENEW^VAFCTFU(PDFN,CMOR) "RTN","VAFCTFU",72,0) ;create the entry in the pivot to broadcast the MFU. "RTN","VAFCTFU",73,0) ; Note: we will not broadcast to the MFU if the TFL record "RTN","VAFCTFU",74,0) ; has an event reason. See comments in FILEDIT. *261 gjc@120199 "RTN","VAFCTFU",75,0) I $G(TICN)'=1,$P($$SEND^VAFHUTL,"^",2)>0 D SETSND(PDFN) "RTN","VAFCTFU",76,0) FILEQ Q "RTN","VAFCTFU",77,0) ; "RTN","VAFCTFU",78,0) FILENEW(PDFN,FAC,PDLT,EVNTR,VAFCSLT,ERROR) ; "RTN","VAFCTFU",79,0) N DGSENFLG ;**240 added y "RTN","VAFCTFU",80,0) K DD,DO,DIC,DA,RESULT "RTN","VAFCTFU",81,0) S DGSENFLG="" "RTN","VAFCTFU",82,0) N FDA,FDAIEN,ERR S ERR="" "RTN","VAFCTFU",83,0) I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT "RTN","VAFCTFU",84,0) S FDA(1,391.91,"+1,",.01)=PDFN "RTN","VAFCTFU",85,0) S FDA(1,391.91,"+1,",.02)=FAC "RTN","VAFCTFU",86,0) S FDA(1,391.91,"+1,",.03)=$G(PDLT) "RTN","VAFCTFU",87,0) S FDA(1,391.91,"+1,",.07)=$G(EVNTR) "RTN","VAFCTFU",88,0) L +^DGCN(391.91,0):30 "RTN","VAFCTFU",89,0) I '$D(^DGCN(391.91,"APAT",PDFN,FAC)) D UPDATE^DIE("","FDA(1)","FDAIEN","ERR") I $D(ERR("DIERR",1)) S ERROR(STA)="Add of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1)) "RTN","VAFCTFU",90,0) ;removed code to add a subscription "RTN","VAFCTFU",91,0) L -^DGCN(391.91,0) "RTN","VAFCTFU",92,0) K DIC,DD,DO,DA "RTN","VAFCTFU",93,0) Q "RTN","VAFCTFU",94,0) ; "RTN","VAFCTFU",95,0) SETSND(PDFN) ;sets the pivot file entry to send MFU "RTN","VAFCTFU",96,0) ; "RTN","VAFCTFU",97,0) N ANS,X "RTN","VAFCTFU",98,0) S X="MPIF001" X ^%ZOSF("TEST") Q:'$T "RTN","VAFCTFU",99,0) ; check if other facilities other than CMOR in TF list "RTN","VAFCTFU",100,0) N SIT,CMOR,STOP "RTN","VAFCTFU",101,0) S CMOR=$$GETVCCI^MPIF001(PDFN) "RTN","VAFCTFU",102,0) S CMOR=$$LKUP^XUAF4(CMOR) ; **520 REMOVED + "RTN","VAFCTFU",103,0) I CMOR=$P($$SITE^VASITE,"^") D "RTN","VAFCTFU",104,0) .S SIT=0 "RTN","VAFCTFU",105,0) .S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) "RTN","VAFCTFU",106,0) .I SIT=CMOR S SIT=$O(^DGCN(391.91,"APAT",PDFN,SIT)) I SIT="" S STOP="" "RTN","VAFCTFU",107,0) I $D(STOP) QUIT "RTN","VAFCTFU",108,0) S ANS=$$PIVNW^VAFHPIVT(PDFN,DT,5,PDFN_";DPT(") "RTN","VAFCTFU",109,0) I 'ANS QUIT "RTN","VAFCTFU",110,0) D XMITFLAG^VAFCDD01(0,+ANS,0) "RTN","VAFCTFU",111,0) SETSNDQ Q "RTN","VAFCTFU",112,0) ; "RTN","VAFCTFU",113,0) FILEDIT(TFIEN,PDLT,PDFN,FAC,EVNTR,VAFCSLT,ERROR) ; "RTN","VAFCTFU",114,0) N DGSENFLG,FDA,FDAIEN,ERR,RESULT S DGSENFLG="",ERR="" "RTN","VAFCTFU",115,0) I $G(PDLT)'="" D "RTN","VAFCTFU",116,0) .S TFIEN(0)=$G(^DGCN(391.91,TFIEN,0)) "RTN","VAFCTFU",117,0) .I $G(EVNTR)'="" D CHK^DIE(391.91,.07,"",EVNTR,.RESULT) I +RESULT>0 S EVNTR=RESULT "RTN","VAFCTFU",118,0) .S FDA(1,391.91,+TFIEN_",",.03)=$G(PDLT) "RTN","VAFCTFU",119,0) .S FDA(1,391.91,+TFIEN_",",.07)=$G(EVNTR) "RTN","VAFCTFU",120,0) .D FILE^DIE("K","FDA(1)","ERR") I VAFCSLT I $D(ERR("DIERR",1)) S ERROR(STA)="Edit of "_STA_" Failed at "_$P($$SITE^VASITE,"^",3)_" due to "_$G(ERR("DIERR",1,"TEXT",1)) "RTN","VAFCTFU",121,0) ;remove code to add a subscription "RTN","VAFCTFU",122,0) Q "RTN","VAFCTFU",123,0) ; "RTN","VAFCTFU",124,0) DELETETF(PAT,INST) ;deletion entry point "RTN","VAFCTFU",125,0) ;This entry point is used to delete a single Treating Facility from "RTN","VAFCTFU",126,0) ;the Treating Facility list. "RTN","VAFCTFU",127,0) ;INPUT PAT - the ICN of the patient. "RTN","VAFCTFU",128,0) ; INST - the IEN of the institution to be deleted. "RTN","VAFCTFU",129,0) ; "RTN","VAFCTFU",130,0) ;OUTPUT 0 (zero) - If no errors "RTN","VAFCTFU",131,0) ; 1^error description if there was a problem "RTN","VAFCTFU",132,0) ; "RTN","VAFCTFU",133,0) N VAFCER,PDFN,TFIEN,X,VAFCSCN,LINK,VAFCLLN,IEN "RTN","VAFCTFU",134,0) S VAFCER=0 "RTN","VAFCTFU",135,0) I '$G(PAT)!('$G(INST)) S VAFCER="1^Parameter missing." S ERROR(INST)="212"_"^"_$G(HL("MID"))_"^"_"Delete Failed: "_$P(VAFCER,"^") G DELTFQ "RTN","VAFCTFU",136,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T G FILETFQ "RTN","VAFCTFU",137,0) S PDFN=$$GETDFN^MPIF001(+PAT) "RTN","VAFCTFU",138,0) I PDFN<0 S VAFCER="1^No patient DFN." G FILETFQ "RTN","VAFCTFU",139,0) I '$$FIND1^DIC(4,"","MX","`"_INST) S VAFCER="1^Not an Institution IEN." G DELTFQ "RTN","VAFCTFU",140,0) S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0)) "RTN","VAFCTFU",141,0) I 'TFIEN S VAFCER="1^Could not find Treating Facility." G DELTFQ "RTN","VAFCTFU",142,0) D DELETE(TFIEN) "RTN","VAFCTFU",143,0) S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,INST,0)) "RTN","VAFCTFU",144,0) I TFIEN S VAFCER="1^DIK failed to delete entry" G DELTFQ "RTN","VAFCTFU",145,0) ;terminate the subscription if there is one "RTN","VAFCTFU",146,0) S VAFCSCN=+$P($$MPINODE^MPIFAPI(PDFN),"^",5) I +$G(VAFCSCN)>0 D "RTN","VAFCTFU",147,0) .;get logical link "RTN","VAFCTFU",148,0) . D LINK^HLUTIL3(INST,.LINK) S VAFCLLN=$O(LINK(0)) I +$G(VAFCLLN)>0 S VAFCLLN=LINK(VAFCLLN) D UPD^HLSUB(VAFCSCN,VAFCLLN,0,,$$NOW^XLFDT,,.HLER) "RTN","VAFCTFU",149,0) D RETPDR^VAFCEHU2(PDFN,INST) ;**474 retire pdr when deleting tf "RTN","VAFCTFU",150,0) DELTFQ Q VAFCER "RTN","VAFCTFU",151,0) ; "RTN","VAFCTFU",152,0) DELETE(TFIEN) ;the actual deletion code "RTN","VAFCTFU",153,0) ; "RTN","VAFCTFU",154,0) K DIK,DA "RTN","VAFCTFU",155,0) S DIK="^DGCN(391.91," "RTN","VAFCTFU",156,0) S DA=TFIEN "RTN","VAFCTFU",157,0) D ^DIK K DIK,DA "RTN","VAFCTFU",158,0) Q "RTN","VAFCTFU",159,0) ; "RTN","VAFCTFU",160,0) DELALLTF(PAT) ;Entry point to delete all Treating Facilities for a single "RTN","VAFCTFU",161,0) ;patient. "RTN","VAFCTFU",162,0) ;INPUT PAT - The patient's ICN "RTN","VAFCTFU",163,0) ;OUTPUT 0 (zero) - If no errors "RTN","VAFCTFU",164,0) ; 1^error description if an error "RTN","VAFCTFU",165,0) ; "RTN","VAFCTFU",166,0) N VAFCER,PDFN,LP,TFIEN,X "RTN","VAFCTFU",167,0) S VAFCER=0 "RTN","VAFCTFU",168,0) I '$G(PAT) Q "1^Parameter missing." "RTN","VAFCTFU",169,0) S X="MPIF001" X ^%ZOSF("TEST") I '$T Q 0 "RTN","VAFCTFU",170,0) S PDFN=$$GETDFN^MPIF001(PAT) "RTN","VAFCTFU",171,0) I PDFN<0 Q "1^No patient DFN." "RTN","VAFCTFU",172,0) F LP=0:0 S LP=$O(^DGCN(391.91,"APAT",PDFN,LP)) Q:LP'>0 D "RTN","VAFCTFU",173,0) . S TFIEN=0 "RTN","VAFCTFU",174,0) . F S TFIEN=$O(^DGCN(391.91,"APAT",PDFN,LP,TFIEN)) Q:TFIEN'>0 D DELETE(TFIEN) "RTN","VAFCTFU",175,0) ; "RTN","VAFCTFU",176,0) Q VAFCER "RTN","VAFCTFU",177,0) ; "VER") 8.0^22.0 "BLD",6574,6) ^613 **END** **END**