Released DG*5.3*614 SEQ #571 Extracted from mail message **KIDS**:DG*5.3*614^ **INSTALL NAME** DG*5.3*614 "BLD",5697,0) DG*5.3*614^REGISTRATION^0^3050324^y "BLD",5697,1,0) ^^5^5^3050202^ "BLD",5697,1,1,0) 1. Prevent sending blank message to Austin "BLD",5697,1,2,0) "BLD",5697,1,3,0) 2. Expand DG1 segment in HL7 RAI/MDS packet to include up to 13 diagnosis "BLD",5697,1,4,0) "BLD",5697,1,5,0) 3. Error during the Process Dicom Images on DIG1 with a broker error. "BLD",5697,4,0) ^9.64PA^45^1 "BLD",5697,4,45,0) 45 "BLD",5697,4,45,2,0) ^9.641^45^1 "BLD",5697,4,45,2,45,0) PTF (File-top level) "BLD",5697,4,45,2,45,1,0) ^9.6411^79.244^4 "BLD",5697,4,45,2,45,1,79.241,0) SECONDARY DIAGNOSIS 10 "BLD",5697,4,45,2,45,1,79.242,0) SECONDARY DIAGNOSIS 11 "BLD",5697,4,45,2,45,1,79.243,0) SECONDARY DIAGNOSIS 12 "BLD",5697,4,45,2,45,1,79.244,0) SECONDARY DIAGNOSIS 13 "BLD",5697,4,45,222) y^n^p^^^^n^^n "BLD",5697,4,45,224) "BLD",5697,4,"APDD",45,45) "BLD",5697,4,"APDD",45,45,79.241) "BLD",5697,4,"APDD",45,45,79.242) "BLD",5697,4,"APDD",45,45,79.243) "BLD",5697,4,"APDD",45,45,79.244) "BLD",5697,4,"B",45,45) "BLD",5697,"KRN",0) ^9.67PA^8989.52^19 "BLD",5697,"KRN",.4,0) .4 "BLD",5697,"KRN",.401,0) .401 "BLD",5697,"KRN",.402,0) .402 "BLD",5697,"KRN",.403,0) .403 "BLD",5697,"KRN",.5,0) .5 "BLD",5697,"KRN",.84,0) .84 "BLD",5697,"KRN",3.6,0) 3.6 "BLD",5697,"KRN",3.8,0) 3.8 "BLD",5697,"KRN",9.2,0) 9.2 "BLD",5697,"KRN",9.8,0) 9.8 "BLD",5697,"KRN",9.8,"NM",0) ^9.68A^5^3 "BLD",5697,"KRN",9.8,"NM",2,0) VAFHLDG1^^0^B30271941 "BLD",5697,"KRN",9.8,"NM",3,0) DGPTFTR^^0^B19026015 "BLD",5697,"KRN",9.8,"NM",5,0) VADPT1^^0^B36674787 "BLD",5697,"KRN",9.8,"NM","B","DGPTFTR",3) "BLD",5697,"KRN",9.8,"NM","B","VADPT1",5) "BLD",5697,"KRN",9.8,"NM","B","VAFHLDG1",2) "BLD",5697,"KRN",19,0) 19 "BLD",5697,"KRN",19,"NM",0) ^9.68A^^ "BLD",5697,"KRN",19.1,0) 19.1 "BLD",5697,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",5697,"KRN",101,0) 101 "BLD",5697,"KRN",409.61,0) 409.61 "BLD",5697,"KRN",771,0) 771 "BLD",5697,"KRN",870,0) 870 "BLD",5697,"KRN",8989.51,0) 8989.51 "BLD",5697,"KRN",8989.52,0) 8989.52 "BLD",5697,"KRN",8994,0) 8994 "BLD",5697,"KRN","B",.4,.4) "BLD",5697,"KRN","B",.401,.401) "BLD",5697,"KRN","B",.402,.402) "BLD",5697,"KRN","B",.403,.403) "BLD",5697,"KRN","B",.5,.5) "BLD",5697,"KRN","B",.84,.84) "BLD",5697,"KRN","B",3.6,3.6) "BLD",5697,"KRN","B",3.8,3.8) "BLD",5697,"KRN","B",9.2,9.2) "BLD",5697,"KRN","B",9.8,9.8) "BLD",5697,"KRN","B",19,19) "BLD",5697,"KRN","B",19.1,19.1) "BLD",5697,"KRN","B",101,101) "BLD",5697,"KRN","B",409.61,409.61) "BLD",5697,"KRN","B",771,771) "BLD",5697,"KRN","B",870,870) "BLD",5697,"KRN","B",8989.51,8989.51) "BLD",5697,"KRN","B",8989.52,8989.52) "BLD",5697,"KRN","B",8994,8994) "BLD",5697,"QUES",0) ^9.62^^ "BLD",5697,"REQB",0) ^9.611^7^3 "BLD",5697,"REQB",5,0) DG*5.3*516^1 "BLD",5697,"REQB",6,0) DG*5.3*606^1 "BLD",5697,"REQB",7,0) DG*5.3*601^1 "BLD",5697,"REQB","B","DG*5.3*516",5) "BLD",5697,"REQB","B","DG*5.3*601",7) "BLD",5697,"REQB","B","DG*5.3*606",6) "FIA",45) PTF "FIA",45,0) ^DGPT( "FIA",45,0,0) 45IP "FIA",45,0,1) y^n^p^^^^n^^n "FIA",45,0,10) "FIA",45,0,11) "FIA",45,0,"RLRO") "FIA",45,0,"VR") 5.3^DG "FIA",45,45) 1 "FIA",45,45,79.241) "FIA",45,45,79.242) "FIA",45,45,79.243) "FIA",45,45,79.244) "IX",45,45,"ACR9DSD10",0) 45^ACR9DSD10^Clinical Reminders index for ICD9 lookup.^MU^^R^IR^I^45^^^^^A "IX",45,45,"ACR9DSD10",.1,0) ^^11^11^3050110 "IX",45,45,"ACR9DSD10",.1,1,0) This cross-reference builds two indexes, one for finding "IX",45,45,"ACR9DSD10",.1,2,0) all patients with a particular ICD9 code and one for finding all "IX",45,45,"ACR9DSD10",.1,3,0) the ICD9 codes a patient has. "IX",45,45,"ACR9DSD10",.1,4,0) The indexes are stored in the Clinical Reminders index global as: "IX",45,45,"ACR9DSD10",.1,5,0) ^PXRMINDX(45,"ICD9","INP",ICD9,NAME,DFN,DATE,DAS) and "IX",45,45,"ACR9DSD10",.1,6,0) ^PXRMINDX(45,"ICD9","PNI",DFN,NAME,ICD9,DATE,DAS) "IX",45,45,"ACR9DSD10",.1,7,0) respectively. DATE is the discharge date. If it does not "IX",45,45,"ACR9DSD10",.1,8,0) exist then the admission date is used. "IX",45,45,"ACR9DSD10",.1,9,0) NAME is the name of the ICD9 code field. An example is D SD10, where D SD tells us it is a discharge secondary diagnosis. "IX",45,45,"ACR9DSD10",.1,10,0) If the TYPE OF RECORD is CENSUS then the entry is not indexed. "IX",45,45,"ACR9DSD10",.1,11,0) For all the details, see the Clinical Reminders Index Technical Guide/Programmer's Manual. "IX",45,45,"ACR9DSD10",1) D SDGPT9D^DGPTDDCR(.X,.DA,"D SD10") "IX",45,45,"ACR9DSD10",2) D KDGPT9D^DGPTDDCR(.X,.DA,"D SD10") "IX",45,45,"ACR9DSD10",2.5) K ^PXRMINDX(45) "IX",45,45,"ACR9DSD10",11.1,0) ^.114IA^5^5 "IX",45,45,"ACR9DSD10",11.1,1,0) 1^F^45^.01^^1^F "IX",45,45,"ACR9DSD10",11.1,2,0) 2^F^45^2^^2^F "IX",45,45,"ACR9DSD10",11.1,3,0) 3^F^45^11^^3^F "IX",45,45,"ACR9DSD10",11.1,4,0) 4^F^45^79.241^^4^F "IX",45,45,"ACR9DSD10",11.1,5,0) 5^F^45^70 "IX",45,45,"ACR9DSD11",0) 45^ACR9DSD11^Clinical Reminders index for ICD9 lookup.^MU^^R^IR^I^45^^^^^A "IX",45,45,"ACR9DSD11",.1,0) ^^11^11^3050110 "IX",45,45,"ACR9DSD11",.1,1,0) This cross-reference builds two indexes, one for finding "IX",45,45,"ACR9DSD11",.1,2,0) all patients with a particular ICD9 code and one for finding all "IX",45,45,"ACR9DSD11",.1,3,0) the ICD9 codes a patient has. "IX",45,45,"ACR9DSD11",.1,4,0) The indexes are stored in the Clinical Reminders index global as: "IX",45,45,"ACR9DSD11",.1,5,0) ^PXRMINDX(45,"ICD9","INP",ICD9,NAME,DFN,DATE,DAS) and "IX",45,45,"ACR9DSD11",.1,6,0) ^PXRMINDX(45,"ICD9","PNI",DFN,NAME,ICD9,DATE,DAS) "IX",45,45,"ACR9DSD11",.1,7,0) respectively. DATE is the discharge date. If it does not "IX",45,45,"ACR9DSD11",.1,8,0) exist then the admission date is used. "IX",45,45,"ACR9DSD11",.1,9,0) NAME is the name of the ICD9 code field. An example is D SD11, where D SD tells us it is a discharge secondary diagnosis. "IX",45,45,"ACR9DSD11",.1,10,0) If the TYPE OF RECORD is CENSUS then the entry is not indexed. "IX",45,45,"ACR9DSD11",.1,11,0) For all the details, see the Clinical Reminders Index Technical Guide/Programmer's Manual. "IX",45,45,"ACR9DSD11",1) D SDGPT9D^DGPTDDCR(.X,.DA,"D SD11") "IX",45,45,"ACR9DSD11",2) D KDGPT9D^DGPTDDCR(.X,.DA,"D SD11") "IX",45,45,"ACR9DSD11",2.5) K ^PXRMINDX(45) "IX",45,45,"ACR9DSD11",11.1,0) ^.114IA^5^5 "IX",45,45,"ACR9DSD11",11.1,1,0) 1^F^45^.01^^1^F "IX",45,45,"ACR9DSD11",11.1,2,0) 2^F^45^2^^2^F "IX",45,45,"ACR9DSD11",11.1,3,0) 3^F^45^11^^3^F "IX",45,45,"ACR9DSD11",11.1,4,0) 4^F^45^79.242^^4^F "IX",45,45,"ACR9DSD11",11.1,5,0) 5^F^45^70 "IX",45,45,"ACR9DSD12",0) 45^ACR9DSD12^Clinical Reminders index for ICD9 lookup.^MU^^R^IR^I^45^^^^^A "IX",45,45,"ACR9DSD12",.1,0) ^^11^11^3050110 "IX",45,45,"ACR9DSD12",.1,1,0) This cross-reference builds two indexes, one for finding "IX",45,45,"ACR9DSD12",.1,2,0) all patients with a particular ICD9 code and one for finding all "IX",45,45,"ACR9DSD12",.1,3,0) the ICD9 codes a patient has. "IX",45,45,"ACR9DSD12",.1,4,0) The indexes are stored in the Clinical Reminders index global as: "IX",45,45,"ACR9DSD12",.1,5,0) ^PXRMINDX(45,"ICD9","INP",ICD9,NAME,DFN,DATE,DAS) and "IX",45,45,"ACR9DSD12",.1,6,0) ^PXRMINDX(45,"ICD9","PNI",DFN,NAME,ICD9,DATE,DAS) "IX",45,45,"ACR9DSD12",.1,7,0) respectively. DATE is the discharge date. If it does not "IX",45,45,"ACR9DSD12",.1,8,0) exist then the admission date is used. "IX",45,45,"ACR9DSD12",.1,9,0) NAME is the name of the ICD9 code field. An example is D SD12, where D SD tells us it is a discharge secondary diagnosis. "IX",45,45,"ACR9DSD12",.1,10,0) If the TYPE OF RECORD is CENSUS then the entry is not indexed. "IX",45,45,"ACR9DSD12",.1,11,0) For all the details, see the Clinical Reminders Index Technical Guide/Programmer's Manual. "IX",45,45,"ACR9DSD12",1) D SDGPT9D^DGPTDDCR(.X,.DA,"D SD12") "IX",45,45,"ACR9DSD12",2) D KDGPT9D^DGPTDDCR(.X,.DA,"D SD12") "IX",45,45,"ACR9DSD12",2.5) K ^PXRMINDX(45) "IX",45,45,"ACR9DSD12",11.1,0) ^.114IA^5^5 "IX",45,45,"ACR9DSD12",11.1,1,0) 1^F^45^.01^^1^F "IX",45,45,"ACR9DSD12",11.1,2,0) 2^F^45^2^^2^F "IX",45,45,"ACR9DSD12",11.1,3,0) 3^F^45^11^^3^F "IX",45,45,"ACR9DSD12",11.1,4,0) 4^F^45^79.243^^4^F "IX",45,45,"ACR9DSD12",11.1,5,0) 5^F^45^70 "IX",45,45,"ACR9DSD13",0) 45^ACR9DSD13^Clinical Reminders index for ICD9 lookup.^MU^^R^IR^I^45^^^^^A "IX",45,45,"ACR9DSD13",.1,0) ^^11^11^3050110 "IX",45,45,"ACR9DSD13",.1,1,0) This cross-reference builds two indexes, one for finding "IX",45,45,"ACR9DSD13",.1,2,0) all patients with a particular ICD9 code and one for finding all "IX",45,45,"ACR9DSD13",.1,3,0) the ICD9 codes a patient has. "IX",45,45,"ACR9DSD13",.1,4,0) The indexes are stored in the Clinical Reminders index global as: "IX",45,45,"ACR9DSD13",.1,5,0) ^PXRMINDX(45,"ICD9","INP",ICD9,NAME,DFN,DATE,DAS) and "IX",45,45,"ACR9DSD13",.1,6,0) ^PXRMINDX(45,"ICD9","PNI",DFN,NAME,ICD9,DATE,DAS) "IX",45,45,"ACR9DSD13",.1,7,0) respectively. DATE is the discharge date. If it does not "IX",45,45,"ACR9DSD13",.1,8,0) exist then the admission date is used. "IX",45,45,"ACR9DSD13",.1,9,0) NAME is the name of the ICD9 code field. An example is D SD13, where D SD tells us it is a discharge secondary diagnosis. "IX",45,45,"ACR9DSD13",.1,10,0) If the TYPE OF RECORD is CENSUS then the entry is not indexed. "IX",45,45,"ACR9DSD13",.1,11,0) For all the details, see the Clinical Reminders Index Technical Guide/Programmer's Manual. "IX",45,45,"ACR9DSD13",1) D SDGPT9D^DGPTDDCR(.X,.DA,"D SD13") "IX",45,45,"ACR9DSD13",2) D KDGPT9D^DGPTDDCR(.X,.DA,"D SD13") "IX",45,45,"ACR9DSD13",2.5) K ^PXRMINDX(45) "IX",45,45,"ACR9DSD13",11.1,0) ^.114IA^5^5 "IX",45,45,"ACR9DSD13",11.1,1,0) 1^F^45^.01^^1^F "IX",45,45,"ACR9DSD13",11.1,2,0) 2^F^45^2^^2^F "IX",45,45,"ACR9DSD13",11.1,3,0) 3^F^45^11^^3^F "IX",45,45,"ACR9DSD13",11.1,4,0) 4^F^45^79.244^^4^F "IX",45,45,"ACR9DSD13",11.1,5,0) 5^F^45^70 "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) 614^3050324 "PKG",5,22,1,"PAH",1,1,0) ^^5^5^3050324 "PKG",5,22,1,"PAH",1,1,1,0) 1. Prevent sending blank message to Austin "PKG",5,22,1,"PAH",1,1,2,0) "PKG",5,22,1,"PAH",1,1,3,0) 2. Expand DG1 segment in HL7 RAI/MDS packet to include up to 13 diagnosis "PKG",5,22,1,"PAH",1,1,4,0) "PKG",5,22,1,"PAH",1,1,5,0) 3. Error during the Process Dicom Images on DIG1 with a broker error. "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","DGPTFTR") 0^3^B19026015 "RTN","DGPTFTR",1,0) DGPTFTR ;ALB/JDS - TRANSMISSION OF PTF ; 3/24/05 5:36pm "RTN","DGPTFTR",2,0) ;;5.3;Registration;**37,415,530,601,614**;Aug 13, 1993 "RTN","DGPTFTR",3,0) ; "RTN","DGPTFTR",4,0) ENN L ^DGP(45.83):5 I '$T W !,"Already transmitting" Q "RTN","DGPTFTR",5,0) D CEN^DGPTUTL "RTN","DGPTFTR",6,0) I '$D(DGRTY) S Y=1 D RTY^DGPTUTL "RTN","DGPTFTR",7,0) D FDT^DGPTUTL S DGFMTDT=Y "RTN","DGPTFTR",8,0) ; "RTN","DGPTFTR",9,0) EN5 K DIC S DIC=45.83,DIC(0)="AMZEQ",DIC("A")="Enter Start Date: " "RTN","DGPTFTR",10,0) S DIC("S")="I $O(^DGP(45.83,+Y,""P"",0)) F DGX=0:0 S DGX=$O(^DGP(45.83,+Y,""P"",DGX)) Q:'DGX I '$P(^DGP(45.83,+Y,""P"",DGX,0),U,2),$D(^DGPT(DGX,0)),$D(^(70)),+^(70)>2901000,$P(^(0),U,11)=+DGRTY Q" "RTN","DGPTFTR",11,0) S D="ANT" D IX^DIC G ENQ1:X["^"!(X=""),EN5:Y'>0 "RTN","DGPTFTR",12,0) S DGSD=+Y(0),DIC(0)="EAMZQ",DIC("S")="I Y'0:+Y(0),1:DT) "RTN","DGPTFTR",15,0) ; -- 125 cols "RTN","DGPTFTR",16,0) S VATNAME="PTF125" D ^VATRAN I VATERR K VATNAME,VATERR,VAT L G ENQ "RTN","DGPTFTR",17,0) S DGFMT=2 D SCAN G:DGOUTX ENQ1 "RTN","DGPTFTR",18,0) ENQ D SCAN^DGPTFTR3 "RTN","DGPTFTR",19,0) ENQ1 L K DGACNT,DGXM,XMDUN,XMY,DGOUTX,DGSTCNT,DIC,DGX,DGRTY,DGRTY0,DGCN,DGCN0,DGPTFMT,DGFMT,DGFMTDT,DGLOGIC,VAT,VATERR,VATNAME,DGSD,DGED "RTN","DGPTFTR",20,0) Q "RTN","DGPTFTR",21,0) ; "RTN","DGPTFTR",22,0) SCAN K DGERR S DGPTFMT=2 D LOG S DGCNT=1,DGD=DGSD-.01,DGTR=0,DGID=1 "RTN","DGPTFTR",23,0) ; DG*5.3*614 - DGFIRST identifies first record in a batch "RTN","DGPTFTR",24,0) N DGFIRST S DGFIRST=1 "RTN","DGPTFTR",25,0) W !!,"Now transmitting 125 column ",$P(DGRTY0,U)," records..." "RTN","DGPTFTR",26,0) W !,"Includes records of " "RTN","DGPTFTR",27,0) ; "RTN","DGPTFTR",28,0) DAT D:DGCNT>1 XMIT S DGD=$O(^DGP(45.83,DGD)) "RTN","DGPTFTR",29,0) I DGD>0,DGD'>DGED D SETTRAN^DGPTUTL1 Q:DGOUTX "RTN","DGPTFTR",30,0) I DGD'>0!(DGD>DGED) D BULL^DGPTFTR3 G DATQ "RTN","DGPTFTR",31,0) S J=0 G PWR "RTN","DGPTFTR",32,0) DATQ Q "RTN","DGPTFTR",33,0) ; "RTN","DGPTFTR",34,0) PWR S P=J,J=$O(^DGP(45.83,DGD,"P",J)) G DAT:J'>0,PWR:$P(^(J,0),U,2) "RTN","DGPTFTR",35,0) I $D(^DGPT(J,0)),$P(^(0),U,11)'=+DGRTY G PWR "RTN","DGPTFTR",36,0) I $P(DGCN0,U,3)>DT,DGRTY=1 D CEN^DGPTFTR3 G PWR:'Y "RTN","DGPTFTR",37,0) S Y=$S($D(^DGPT(J,70)):+^(70),1:0) D FMT^DGPTUTL G PWR:DGPTFMT'=DGFMT "RTN","DGPTFTR",38,0) S T1=0,T2=9999999,Y=J,X=0 S:DGRTY=2 T2=+DGCN0_".9",T1=+$P(DGCN0,U,5) D LINES^DGPTFVC2 I (DGCNT+X)>VAT("F"),'$G(DGFIRST) S J=P G XMIT "RTN","DGPTFTR",39,0) I $G(DGFIRST)=1 S DGFIRST=0 "RTN","DGPTFTR",40,0) K DICR S DGERR=0,DGSTCNT("P",J)=DGCNT "RTN","DGPTFTR",41,0) W !,$E($P(^DPT(+^DGPT(J,0),0),U),1,25),?27,"(#",J,")" S X=^DGPT(J,0) D WR^DGPTF "RTN","DGPTFTR",42,0) K ^TMP("AEDIT",$J),^TMP("AERROR",$J) S DGACNT=0 "RTN","DGPTFTR",43,0) I DGRTY=1 D COM "RTN","DGPTFTR",44,0) I DGRTY=2 S T2=+DGCN0_".9",T1=+$P(DGCN0,U,5),(PTF,DGCI)=J D COM1 "RTN","DGPTFTR",45,0) I DGERR D OPEN^DGPTFTR3 "RTN","DGPTFTR",46,0) K ^TMP("AEDIT",$J) "RTN","DGPTFTR",47,0) I 'DGERR W ?70," Okay" S DGTR=DGTR+1 G XMIT:DGCNT>VAT("F") "RTN","DGPTFTR",48,0) G PWR "RTN","DGPTFTR",49,0) Q "RTN","DGPTFTR",50,0) ; "RTN","DGPTFTR",51,0) XMIT K XMY D ROUTER "RTN","DGPTFTR",52,0) S XMZ=DGXMZ,^XMB(3.9,XMZ,2,0)="^3.92A^"_(DGCNT-1)_"^"_(DGCNT-1)_"^"_DT,DGJ=J "RTN","DGPTFTR",53,0) S XMDUZ=.5,XMDUN=$P(^VA(200,DUZ,0),U) D ENT1^XMD "RTN","DGPTFTR",54,0) W !,"Transmission Queued" S DGIDN(DGID)=XMZ "RTN","DGPTFTR",55,0) F DGK=0:0 S DGK=$O(DGSTCNT("P",DGK)) Q:DGK'>0 D REC "RTN","DGPTFTR",56,0) S DGFIRST=1 "RTN","DGPTFTR",57,0) K DGK S DGCNT=1,DGID=DGID+1,J=DGJ Q:J'>0 D SETTRAN^DGPTUTL1 G:'DGOUTX PWR "RTN","DGPTFTR",58,0) Q "RTN","DGPTFTR",59,0) ; "RTN","DGPTFTR",60,0) REC ; "RTN","DGPTFTR",61,0) S DGSENFLG="" "RTN","DGPTFTR",62,0) S DIE="^DGP(45.83,",DA=DGD,DR="10///"_DGK,DR(2,45.831)="1///TODAY;2///"_XMZ D ^DIE K DA,DR,DIE "RTN","DGPTFTR",63,0) S DIE="^DGPT(",DR="6///3",DA=DGK D ^DIE K DA,DR,DIE "RTN","DGPTFTR",64,0) K DGSENFLG "RTN","DGPTFTR",65,0) Q "RTN","DGPTFTR",66,0) ; "RTN","DGPTFTR",67,0) COM S T1=0,T2=9999999 S:'$D(PTF) PTF=J S:PTF'=J PTF=J "RTN","DGPTFTR",68,0) COM1 F K=0,70,101,"401P" S @("DG"_K)=$S($D(^DGPT(J,K)):^(K),1:"") "RTN","DGPTFTR",69,0) F K=10,.11,.3,.32,.321,.52,57 S @("DG"_$S(K[".":$E(K,2,99),1:K))=$S($D(^DGP(45.84,J,K)):^(K),$D(^DPT(+^DGPT(J,0),$S(K'=10:K,1:0))):$S(K'=10:^(K),1:^(0)),1:"") "RTN","DGPTFTR",70,0) F K=.02,.06 M @("DG"_$S(K[".":$E(K,2,99),1:K))=^DPT(+^DGPT(J,0),K) "RTN","DGPTFTR",71,0) D ^DGPTFTR0:DGPTFMT=1,^DGPTR0:DGPTFMT=2 "RTN","DGPTFTR",72,0) ; "RTN","DGPTFTR",73,0) Q L F K=0,10,701,"401P",101,11,3,32,41,52,57,70,321,502,702,"02","06" K @("DG"_K) "RTN","DGPTFTR",74,0) K DGCDR,DGT,DIC,DGADM,DGAO,DGDOB,DGHEAD,DGJ,DGK,DGL,DGM,DGNAM,DGNT,DGO,DGSSN,DGSUD,DGSUR,DGTD,DGX,DGXLS,E,ERR,F,G,H,I,K,L,T,W,Z,DGPROC,DGPROCD ;** NOTE: do not kill variables needed by PTF load/edit option!!! "RTN","DGPTFTR",75,0) I $D(DGERR),DGERR<1 D ^DGPTFVC1 D:'T1 ^DGPTFVC3 "RTN","DGPTFTR",76,0) I $D(DGERR),DGERR<1 D EN^DGPTFVC2 "RTN","DGPTFTR",77,0) Q "RTN","DGPTFTR",78,0) ; "RTN","DGPTFTR",79,0) LOG ;called from PRINT+1^DGPTF2,CLS+1^DGPTF2,EN^DGPTFVC "RTN","DGPTFTR",80,0) D LOG^DGPTFTR1:DGPTFMT=1,LOG^DGPTR1:DGPTFMT=2,COM:$D(DGERR) "RTN","DGPTFTR",81,0) Q "RTN","DGPTFTR",82,0) ; "RTN","DGPTFTR",83,0) ;-- check for real queue if census should be removed for national rel "RTN","DGPTFTR",84,0) ROUTER S XMDUZ=.5 F DGSDI=0:0 S DGSDI=$O(VAT(DGSDI)) Q:'DGSDI S X=VAT(DGSDI),XMN=0,XMDF="" D INST^XMA21 K XMN,XMDF "RTN","DGPTFTR",85,0) S XMY(DUZ)="" "RTN","DGPTFTR",86,0) Q "RTN","VADPT1") 0^5^B36674787 "RTN","VADPT1",1,0) VADPT1 ;ALB/MRL/MJK - PATIENT VARIABLES ; 08 DEC 1988 ; 11/9/04 6:17pm "RTN","VADPT1",2,0) ;;5.3;Registration;**415,489,516,614**;Aug 13, 1993 "RTN","VADPT1",3,0) 1 ;Demographic [DEM] "RTN","VADPT1",4,0) N W,Z,NODE "RTN","VADPT1",5,0) ; "RTN","VADPT1",6,0) ; -- name [1 - NM] "RTN","VADPT1",7,0) S VAX=^DPT(DFN,0),@VAV@($P(VAS,"^",1))=$P(VAX,"^") "RTN","VADPT1",8,0) ; "RTN","VADPT1",9,0) ; -- ssn [2 - SS] "RTN","VADPT1",10,0) S Z=$P(VAX,"^",9) S:Z]"" @VAV@($P(VAS,"^",2))=Z_$S(Z]"":"^"_$E(Z,1,3)_"-"_$E(Z,4,5)_"-"_$E(Z,6,10),1:"") "RTN","VADPT1",11,0) ; "RTN","VADPT1",12,0) ; -- date of birth [2 - DB] "RTN","VADPT1",13,0) S Z=$P(VAX,"^",3),Y=Z I Y]"" X ^DD("DD") S @VAV@($P(VAS,"^",3))=Z_"^"_Y "RTN","VADPT1",14,0) ; "RTN","VADPT1",15,0) ; -- age [4 - AG] "RTN","VADPT1",16,0) S W=$S('$D(^DPT(DFN,.35)):"",'^(.35):"",1:+^(.35)) S Y=$S('W:DT,1:W) S:Z]"" @VAV@($P(VAS,"^",4))=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7)) "RTN","VADPT1",17,0) ; "RTN","VADPT1",18,0) ; -- expired date [6 - EX] "RTN","VADPT1",19,0) S (Y,Z)=W X:Y]"" ^DD("DD") S:Z]"" @VAV@($P(VAS,"^",6))=Z_"^"_Y "RTN","VADPT1",20,0) ; "RTN","VADPT1",21,0) ; -- sex [5 - SX] "RTN","VADPT1",22,0) S Z=$P(VAX,"^",2) S:Z]"" @VAV@($P(VAS,"^",5))=Z_"^"_$S(Z="M":"MALE",Z="F":"FEMALE",1:"") K Z "RTN","VADPT1",23,0) ; "RTN","VADPT1",24,0) ; -- remarks [7 - RE] "RTN","VADPT1",25,0) S @VAV@($P(VAS,"^",7))=$P(VAX,"^",10) "RTN","VADPT1",26,0) ; "RTN","VADPT1",27,0) ; -- historic race [8 - RA] "RTN","VADPT1",28,0) S Z=$P(VAX,"^",6),@VAV@($P(VAS,"^",8))=Z_$S($D(^DIC(10,+Z,0)):"^"_$P(^(0),"^"),1:"") "RTN","VADPT1",29,0) ; "RTN","VADPT1",30,0) ; -- religion [9 - RP] "RTN","VADPT1",31,0) S Z=$P(VAX,"^",8),@VAV@($P(VAS,"^",9))=Z_$S($D(^DIC(13,+Z,0)):"^"_$P(^(0),"^"),1:"") "RTN","VADPT1",32,0) ; "RTN","VADPT1",33,0) ; -- marital status [10 - MS] "RTN","VADPT1",34,0) S Z=$P(VAX,"^",5),@VAV@($P(VAS,"^",10))=Z_$S($D(^DIC(11,+Z,0)):"^"_$P(^(0),"^"),1:"") "RTN","VADPT1",35,0) ; "RTN","VADPT1",36,0) ; -- ethnicity [11 - ET] "RTN","VADPT1",37,0) S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.06,X)) Q:'X D "RTN","VADPT1",38,0) .S NODE=$G(^DPT(DFN,.06,X,0)),Z=$P(NODE,"^",1) I Z D "RTN","VADPT1",39,0) ..S @VAV@($P(VAS,"^",11),Y)=Z_"^"_$P($G(^DIC(10.2,Z,0)),"^",1) "RTN","VADPT1",40,0) ..; -- collection method "RTN","VADPT1",41,0) ..S Z=$P(NODE,"^",2) I Z D "RTN","VADPT1",42,0) ...S @VAV@($P(VAS,"^",11),Y,1)=Z_"^"_$P($G(^DIC(10.3,Z,0)),"^",1) "RTN","VADPT1",43,0) S @VAV@($P(VAS,"^",11))=Y-1 "RTN","VADPT1",44,0) ; "RTN","VADPT1",45,0) ; -- race [12 - RC] "RTN","VADPT1",46,0) S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.02,X)) Q:'X D "RTN","VADPT1",47,0) .S NODE=$G(^DPT(DFN,.02,X,0)),Z=$P(NODE,"^",1) I Z D "RTN","VADPT1",48,0) ..S @VAV@($P(VAS,"^",12),Y)=Z_"^"_$P($G(^DIC(10,Z,0)),"^",1) "RTN","VADPT1",49,0) ..; -- collection method "RTN","VADPT1",50,0) ..S Z=$P(NODE,"^",2) I Z D "RTN","VADPT1",51,0) ...S @VAV@($P(VAS,"^",12),Y,1)=Z_"^"_$P($G(^DIC(10.3,Z,0)),"^",1) "RTN","VADPT1",52,0) S @VAV@($P(VAS,"^",12))=Y-1 "RTN","VADPT1",53,0) Q "RTN","VADPT1",54,0) ; "RTN","VADPT1",55,0) 2 ;Other Patient Variables [OPD] "RTN","VADPT1",56,0) N W,Z "RTN","VADPT1",57,0) S VAX=^DPT(DFN,0) "RTN","VADPT1",58,0) ; "RTN","VADPT1",59,0) ; -- city of birth [1 - BC] "RTN","VADPT1",60,0) S @VAV@($P(VAS,"^",1))=$P(VAX,"^",11) "RTN","VADPT1",61,0) ; "RTN","VADPT1",62,0) ; -- state of birth [2 - BS] "RTN","VADPT1",63,0) S Z=$P(VAX,"^",12),@VAV@($P(VAS,"^",2))=Z_$S($D(^DIC(5,+Z,0)):"^"_$P(^(0),"^",1),1:"") "RTN","VADPT1",64,0) ; "RTN","VADPT1",65,0) ; -- occupation [6 - OC] "RTN","VADPT1",66,0) S @VAV@($P(VAS,"^",6))=$P(VAX,"^",7) "RTN","VADPT1",67,0) ; "RTN","VADPT1",68,0) ; -- names "RTN","VADPT1",69,0) S VAX=$S($D(^DPT(DFN,.24)):^(.24),1:"") "RTN","VADPT1",70,0) S @VAV@($P(VAS,"^",3))=$P(VAX,"^",1) ; father's [3 - FN] "RTN","VADPT1",71,0) S @VAV@($P(VAS,"^",4))=$P(VAX,"^",2) ; mother's [4 - MN] "RTN","VADPT1",72,0) S @VAV@($P(VAS,"^",5))=$P(VAX,"^",3) ; mother's maiden [5 - MM] "RTN","VADPT1",73,0) ; "RTN","VADPT1",74,0) ; -- employment status [7 - ES] "RTN","VADPT1",75,0) S VAX=$S($D(^DPT(DFN,.311)):^(.311),1:""),W="EMPLOYED FULL TIME^EMPLOYED PART TIME^NOT EMPLOYED^SELF EMPLOYED^RETIRED^ACTIVE MILITARY DUTY^UNKNOWN" "RTN","VADPT1",76,0) S Z=$P(VAX,"^",15),@VAV@($P(VAS,"^",7))=Z_$S(Z:"^"_$P(W,"^",Z),1:"") "RTN","VADPT1",77,0) Q "RTN","VADPT1",78,0) ; "RTN","VADPT1",79,0) 3 ;Address [ADD] "RTN","VADPT1",80,0) S VABEG=$S($D(VATEST("ADD",9)):VATEST("ADD",9),1:DT),VAEND=$S($D(VATEST("ADD",10)):VATEST("ADD",10),1:DT) "RTN","VADPT1",81,0) I $S($D(VAPA("P")):1,'$D(^DPT(DFN,.121)):1,$P(^(.121),"^",9)'="Y":1,'$P(^(.121),"^",7):1,$P(^(.121),"^",7)>VABEG:1,'$P(^(.121),"^",8):0,1:$P(^(.121),"^",8)VAACTDT)!(VAEND&(VAEND6:1,1:0) S VAX=.21,VAOA("A")=7 "RTN","VADPT1",117,0) E S VAX="."_$P("33^34^211^331^311^25","^",+VAOA("A")) "RTN","VADPT1",118,0) S VAX(1)=VAX,VAX=$S($D(^DPT(DFN,VAX(1))):^(VAX(1)),1:"") I VAX(1)=.25 S VAX=$P(VAX,"^",1)_"^^"_$P(VAX,"^",2,99) "RTN","VADPT1",119,0) S VAX(2)=0 F I=3,4,5,6,7,8 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,"^",VAX(2)))=$P(VAX,"^",I) "RTN","VADPT1",120,0) S @VAV@($P(VAS,"^",7))="",@VAV@($P(VAS,"^",8))=$P(VAX,"^",9),VAX(2)=8 "RTN","VADPT1",121,0) F I=1,2 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,"^",VAX(2)))=$P(VAX,"^",I) "RTN","VADPT1",122,0) I "^.311^.25"[("^"_VAX(1)_"^") S @VAV@($P(VAS,"^",10))="" "RTN","VADPT1",123,0) S VAZ=@VAV@($P(VAS,"^",5)) I VAZ,$D(^DIC(5,+VAZ,0)) S VAZ(1)=$P(^(0),"^",1),@VAV@($P(VAS,"^",5))=VAZ_"^"_VAZ(1) "RTN","VADPT1",124,0) S VAZIP4=$P($G(^DPT(DFN,.22)),U,VAOA("A")) "RTN","VADPT1",125,0) S @VAV@($P(VAS,U,11))=VAZIP4_$S('$G(VAZIP4):"",($L(VAZIP4)=5):U_VAZIP4,1:U_$E(VAZIP4,1,5)_"-"_$E(VAZIP4,6,9)) "RTN","VADPT1",126,0) Q "RTN","VAFHLDG1") 0^2^B30271941 "RTN","VAFHLDG1",1,0) VAFHLDG1 ;ALB/CM/ESD HL7 DG1 SEGMENT BUILDING ; 3/24/05 5:05pm "RTN","VAFHLDG1",2,0) ;;5.3;Registration;**94,151,190,511,606,614**;Aug 13, 1993 "RTN","VAFHLDG1",3,0) ;Routine currently being changed by GRR/EDS "RTN","VAFHLDG1",4,0) ;IN entry is being added "RTN","VAFHLDG1",5,0) ; "RTN","VAFHLDG1",6,0) ;This routine will build an HL7 DG1 segment for an inpatient or "RTN","VAFHLDG1",7,0) ;outpatient event depending on the entry point used. "RTN","VAFHLDG1",8,0) ;Use IN for inpatient "RTN","VAFHLDG1",9,0) ;Use OUT for outpatient "RTN","VAFHLDG1",10,0) ; "RTN","VAFHLDG1",11,0) IN(DFN,VAFHMIEN,VAFSTR,VAOUT,VAFHMDT) ; "RTN","VAFHLDG1",12,0) ;Input parameters "RTN","VAFHLDG1",13,0) ;DFN - Patient's Internal Entry Number "RTN","VAFHLDG1",14,0) ;VAFHMIEN - Internal Entry Number of Movement "RTN","VAFHLDG1",15,0) ;VAFSTR - Sequence numbers of segment to include "RTN","VAFHLDG1",16,0) ;VAOUT - Variable name where output segments should be saved "RTN","VAFHLDG1",17,0) ; "RTN","VAFHLDG1",18,0) K @VAOUT ;Insure output array is empty "RTN","VAFHLDG1",19,0) Q:VAFHMIEN="" "RTN","VAFHLDG1",20,0) N VAFHLREC,VAFHAIEN,VAFHICD "RTN","VAFHLDG1",21,0) S $P(VAFHLREC,HL("FS"))="DG1" ;Set the segment identifier "RTN","VAFHLDG1",22,0) S VAFHMDT=$$GET1^DIQ(405,VAFHMIEN,".01","I") ;Movement Date/Time "RTN","VAFHLDG1",23,0) S VAFHTT=$$GET1^DIQ(405,VAFHMIEN,".02","I") ;Get the movement transaction type (admit, transfer, disharge) "RTN","VAFHLDG1",24,0) I VAFHTT=1 S VAFHAIEN=VAFHMIEN ;If 'admit' movement capture ien "RTN","VAFHLDG1",25,0) I VAFHTT'=1 S VAFHAIEN=$$GET1^DIQ(405,VAFHMIEN,".14","I") ;If not 'admit' movement, get ien of admission movement "RTN","VAFHLDG1",26,0) Q:VAFHAIEN="" ;Quit if no admission movement "RTN","VAFHLDG1",27,0) S VAFHADT=$$GET1^DIQ(405,VAFHAIEN,".01","I") ;Get Admission date/time "RTN","VAFHLDG1",28,0) S VAFHPTF=$O(^DGPT("AAD",DFN,VAFHADT,"")) Q:VAFHPTF="" ;Get pointer to ptf record and quit if none exists "RTN","VAFHLDG1",29,0) S VACNT=0 ;Initialize counter "RTN","VAFHLDG1",30,0) ;I VAFHTT'=3 D ;If not a 'discharge' type, get Movement ICD codes and descriptions "RTN","VAFHLDG1",31,0) ;.S DGLMR=$P($G(^DGPT(VAFHPTF,"M",0)),"^",3) ;Get Last movement ien "RTN","VAFHLDG1",32,0) ;.Q:DGLMR="" ;Quit if no movement entry "RTN","VAFHLDG1",33,0) ;.S DIQ="DGAM",DIQ(0)="I",DIC=45,DR=50,DA=VAFHPTF,DR(45.02)="5:15",DA(45.02)=DGLMR D EN^DIQ1 ;Retrieve the movement ICD fields "RTN","VAFHLDG1",34,0) ;.I $D(DGAM(45.02,DGLMR)) D ;If ICD data exists "RTN","VAFHLDG1",35,0) ;..F VAFLD=5,6,7,8,9,11,12,13,14,15 I $G(DGAM(45.02,DGLMR,VAFLD,"I"))]"" S VACNT=VACNT+1,VAFHICD(VACNT)=DGAM(45.02,DGLMR,VAFLD,"I") ;Check each ICD field for data and store in array if data exists "RTN","VAFHLDG1",36,0) ;I VAFHTT=3 D ;If movement 'discharge' type, get ICD codes and descriptions from discharge data "RTN","VAFHLDG1",37,0) F VAFLD=79,79.16:.01:79.19,79.201,79.21:.01:79.24,79.241,79.242,79.243,79.244 D "RTN","VAFHLDG1",38,0) . S VAFHICD=$$GET1^DIQ(45,VAFHPTF,VAFLD,"I") "RTN","VAFHLDG1",39,0) . I VAFHICD]"" S VACNT=VACNT+1,VAFHICD(VACNT)=VAFHICD ;Check each ICD field for data and store in array if data exists "RTN","VAFHLDG1",40,0) I $O(VAFHICD(0))="" Q ;Quit if no data in ICD array "RTN","VAFHLDG1",41,0) S VACNT=0 F S VACNT=$O(VAFHICD(VACNT)) Q:VACNT="" D ;If array contains ICD data "RTN","VAFHLDG1",42,0) .S $P(VAFHLREC,HL("FS"))="DG1" ;Set segment type to DG1 "RTN","VAFHLDG1",43,0) .S $P(VAFHLREC,HL("FS"),2)=VACNT ;Set Segment Set ID to next sequential number "RTN","VAFHLDG1",44,0) .I VAFSTR[",2," S $P(VAFHLREC,HL("FS"),3)="I9" ;Set 'Diagnosis Coding Method' to reflect ICD9 "RTN","VAFHLDG1",45,0) .I VAFSTR[",3," S $P(VAFHLREC,HL("FS"),4)=$$GET1^DIQ(80,VAFHICD(VACNT),".01","I")_$E(HL("ECH"))_$P($$ICDDX^ICDCODE(VAFHICD(VACNT),VAFHMDT),"^",4) ;Icd Code and Description "RTN","VAFHLDG1",46,0) .I VAFSTR[",5," S $P(VAFHLREC,HL("FS"),6)=$$HLDATE^HLFNC(VAFHMDT) ;Diagnosis Date/Time set to Movement Date/Time "RTN","VAFHLDG1",47,0) .S @VAOUT@(VACNT,0)=VAFHLREC ;Set next node of ICD output array to the newly created segment "RTN","VAFHLDG1",48,0) Q "RTN","VAFHLDG1",49,0) ; "RTN","VAFHLDG1",50,0) ; "RTN","VAFHLDG1",51,0) OUT(DFN,EVT,EVDTS,VPTR,STRP,NUMP) ; "RTN","VAFHLDG1",52,0) ;DFN - Patient File "RTN","VAFHLDG1",53,0) ;EVT - event number from pivot file "RTN","VAFHLDG1",54,0) ;EVDTS - event date/time FileMan "RTN","VAFHLDG1",55,0) ;VPTR - variable pointer "RTN","VAFHLDG1",56,0) ;STRP - string of fields "RTN","VAFHLDG1",57,0) ;(if null - required fields, if "A" - supported "RTN","VAFHLDG1",58,0) ;fields, or string of fields seperated by commas") "RTN","VAFHLDG1",59,0) ;NUMP - ID # (optional) "RTN","VAFHLDG1",60,0) ; "RTN","VAFHLDG1",61,0) N ERR "RTN","VAFHLDG1",62,0) I '$D(NUMP) S NUMP=1 "RTN","VAFHLDG1",63,0) S ERR=$$ODG1^VAFHCDG($G(DFN),$G(EVT),$G(EVDTS),$G(VPTR),$G(STRP),NUMP) "RTN","VAFHLDG1",64,0) Q ERR "RTN","VAFHLDG1",65,0) ; "RTN","VAFHLDG1",66,0) ; "RTN","VAFHLDG1",67,0) EN(VAFENC,VAFSTR,VAFHLQ,VAFHLFS,VAFARRY) ; Entry point for Ambulatory Care Database Project "RTN","VAFHLDG1",68,0) ; - Entry point to return the HL7 DG1 segment "RTN","VAFHLDG1",69,0) ; "RTN","VAFHLDG1",70,0) ; This function will create VA-specific DG1 segment(s) for a "RTN","VAFHLDG1",71,0) ; given outpatient encounter. The DG1 segment is designed to transfer "RTN","VAFHLDG1",72,0) ; generic information about an outpatient diagnosis or diagnoses. "RTN","VAFHLDG1",73,0) ; "RTN","VAFHLDG1",74,0) ; Input: VAFENC - IEN of the Outpatient Encounter (#409.68) file "RTN","VAFHLDG1",75,0) ; VAFSTR - String of fields requested separated by commas "RTN","VAFHLDG1",76,0) ; VAFHLQ - Optional HL7 null variable. If not there, use "RTN","VAFHLDG1",77,0) ; default HL7 variable "RTN","VAFHLDG1",78,0) ; VAFHLFS - Optional HL7 field separator. If not there, use "RTN","VAFHLDG1",79,0) ; default HL7 variable "RTN","VAFHLDG1",80,0) ; VAFARRY - Optional user-supplied array name to hold the HL7 DG1 segments "RTN","VAFHLDG1",81,0) ; "RTN","VAFHLDG1",82,0) ; Output: Array of HL7 DG1 segments "RTN","VAFHLDG1",83,0) ; "RTN","VAFHLDG1",84,0) ; "RTN","VAFHLDG1",85,0) N I,VAFDICDE,VAFIDX,VAFNODE,VAFDNODE,VAFY,VAXY,X,ICDVDT "RTN","VAFHLDG1",86,0) S VAFARRY=$G(VAFARRY),ICDVDT=$$SCE^DGSDU(VAFENC,1,0) "RTN","VAFHLDG1",87,0) ; "RTN","VAFHLDG1",88,0) ; - If VAFARRY not defined, use ^TMP("VAFHL",$J,"DIAGNOSIS") "RTN","VAFHLDG1",89,0) S:(VAFARRY="") VAFARRY="^TMP(""VAFHL"",$J,""DIAGNOSIS"")" "RTN","VAFHLDG1",90,0) ; "RTN","VAFHLDG1",91,0) ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables "RTN","VAFHLDG1",92,0) S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS)) "RTN","VAFHLDG1",93,0) I '$G(VAFENC)!($G(VAFSTR)']"") S @VAFARRY@(1,0)="DG1"_VAFHLFS_1 G ENQ "RTN","VAFHLDG1",94,0) S VAFIDX=0,VAFSTR=","_VAFSTR_"," "RTN","VAFHLDG1",95,0) ; "RTN","VAFHLDG1",96,0) ; - Get all outpatient diagnoses for encounter "RTN","VAFHLDG1",97,0) D GETDX^SDOE(VAFENC,"VAXY") "RTN","VAFHLDG1",98,0) ; "RTN","VAFHLDG1",99,0) ; - Set diagnosis array to 0 if no outpatient diagnosis for encounter "RTN","VAFHLDG1",100,0) I '$G(VAXY) S VAXY(1)=0 "RTN","VAFHLDG1",101,0) ; "RTN","VAFHLDG1",102,0) ALL ; -- All outpatient diagnoses for encounter "RTN","VAFHLDG1",103,0) ; "RTN","VAFHLDG1",104,0) ; -- only send dx once per encounter / build ok array "RTN","VAFHLDG1",105,0) N VAOK "RTN","VAFHLDG1",106,0) F I=0:0 S I=$O(VAXY(I)) Q:'I D "RTN","VAFHLDG1",107,0) . S VAFNODE=VAXY(I) "RTN","VAFHLDG1",108,0) . ; "RTN","VAFHLDG1",109,0) . ; -- if this is first entry for dx then 'ok' it "RTN","VAFHLDG1",110,0) . IF '$D(VAOK(+VAFNODE)) S VAOK(+VAFNODE)=I Q "RTN","VAFHLDG1",111,0) . ; "RTN","VAFHLDG1",112,0) . ; -- if primary then 'ok' it (if two are primary we 'ok' last) "RTN","VAFHLDG1",113,0) . IF $P(VAFNODE,U,12)="P" S VAOK(+VAFNODE)=I "RTN","VAFHLDG1",114,0) ; "RTN","VAFHLDG1",115,0) ; "RTN","VAFHLDG1",116,0) F I=0:0 S I=$O(VAXY(I)) Q:'I D "RTN","VAFHLDG1",117,0) .; "RTN","VAFHLDG1",118,0) .S VAFNODE=VAXY(I) "RTN","VAFHLDG1",119,0) .; "RTN","VAFHLDG1",120,0) .; - build array of HL7 (DG1) segments but only use ok'ed entry for dx "RTN","VAFHLDG1",121,0) .IF $G(VAOK(+VAFNODE))=I D BUILD "RTN","VAFHLDG1",122,0) ; "RTN","VAFHLDG1",123,0) ENQ Q "RTN","VAFHLDG1",124,0) ; "RTN","VAFHLDG1",125,0) ; "RTN","VAFHLDG1",126,0) BUILD ; - Build array of HL7 (DG1) segments "RTN","VAFHLDG1",127,0) S $P(VAFY,VAFHLFS,16)="",VAFIDX=VAFIDX+1 "RTN","VAFHLDG1",128,0) S VAFDICDE="I9" ; Diagnosis Coding Method = I9 (ICD-9) "RTN","VAFHLDG1",129,0) ; "RTN","VAFHLDG1",130,0) ; - Sequential number (required field) "RTN","VAFHLDG1",131,0) S $P(VAFY,VAFHLFS,1)=VAFIDX "RTN","VAFHLDG1",132,0) ; "RTN","VAFHLDG1",133,0) I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=$S($G(VAFDICDE)]"":VAFDICDE,1:VAFHLQ) ; Diagnosis Coding Method = ICD-9 "RTN","VAFHLDG1",134,0) ;I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$G(^ICD9(+$G(VAFNODE),0)) ; Get node from ICD Diagnosis file "RTN","VAFHLDG1",135,0) I (VAFSTR[",3,")!(VAFSTR[",4,") S VAFDNODE=$$ICDDX^ICDCODE(+VAFNODE,$G(ICDVDT)) ; Get node from ICD Diagnosis file "RTN","VAFHLDG1",136,0) I VAFSTR[",3," S X=$P($G(VAFDNODE),"^",2),$P(VAFY,VAFHLFS,3)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Code "RTN","VAFHLDG1",137,0) I VAFSTR[",4," S X=$P($G(VAFDNODE),"^",4),$P(VAFY,VAFHLFS,4)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Description "RTN","VAFHLDG1",138,0) I VAFSTR[",5," S X=$$HLDATE^HLFNC($$SCE^DGSDU(VAFENC,1,0)),$P(VAFY,VAFHLFS,5)=$S(X]"":X,1:VAFHLQ) ; Diagnosis Date/Time (Encounter Date/Time) "RTN","VAFHLDG1",139,0) ; "RTN","VAFHLDG1",140,0) ; - Contains 1 if primary diagnosis, blank otherwise "RTN","VAFHLDG1",141,0) I VAFSTR[",15," S X=$P($G(VAFNODE),"^",12),$P(VAFY,VAFHLFS,15)=$S(X="P":1,1:VAFHLQ) ; Diagnosis Ranking Number "RTN","VAFHLDG1",142,0) ; "RTN","VAFHLDG1",143,0) ; - Set all outpatient diagnoses into array "RTN","VAFHLDG1",144,0) S @VAFARRY@(VAFIDX,0)="DG1"_VAFHLFS_$G(VAFY) "RTN","VAFHLDG1",145,0) Q "VER") 8.0^22.0 "^DD",45,45,79.241,0) SECONDARY DIAGNOSIS 10^*P80'^ICD9(^71;1^S DIC("S")="S DGI=11 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.241,1,0) ^.1 "^DD",45,45,79.241,1,1,0) 45^ADGRU79241^MUMPS "^DD",45,45,79.241,1,1,1) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.241,1,1,2) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.241,1,1,"%D",0) ^.101^1^1^3050324^^^ "^DD",45,45,79.241,1,1,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.241,1,1,"DT") 3050324 "^DD",45,45,79.241,12) Valid Code "^DD",45,45,79.241,12.1) S DIC("S")="S DGI=11 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.241,21,0) ^.001^1^1^3040115^^^^ "^DD",45,45,79.241,21,1,0) This field contains a diagnosis for the patient during this episode of care. "^DD",45,45,79.241,"DT") 3050324 "^DD",45,45,79.242,0) SECONDARY DIAGNOSIS 11^*P80'^ICD9(^71;2^S DIC("S")="S DGI=12 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.242,1,0) ^.1 "^DD",45,45,79.242,1,1,0) 45^ADGRU79242^MUMPS "^DD",45,45,79.242,1,1,1) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.242,1,1,2) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.242,1,1,"%D",0) ^^1^1^3050324^ "^DD",45,45,79.242,1,1,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.242,1,1,"DT") 3050324 "^DD",45,45,79.242,12) Valid Code "^DD",45,45,79.242,12.1) S DIC("S")="S DGI=12 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.242,21,0) ^.001^1^1^3040115^^^^ "^DD",45,45,79.242,21,1,0) This field contains a diagnosis for the patient during this episode of care. "^DD",45,45,79.242,"DT") 3050324 "^DD",45,45,79.243,0) SECONDARY DIAGNOSIS 12^*P80'^ICD9(^71;3^S DIC("S")="S DGI=13 D EN3^DGPTFJC I 'DGER" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X "^DD",45,45,79.243,1,0) ^.1 "^DD",45,45,79.243,1,1,0) 45^ADGRU79243^MUMPS "^DD",45,45,79.243,1,1,1) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.243,1,1,2) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.243,1,1,"%D",0) ^^1^1^3050324^ "^DD",45,45,79.243,1,1,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.243,1,1,"DT") 3050324 "^DD",45,45,79.243,12) Valid Entries "^DD",45,45,79.243,12.1) S DIC("S")="S DGI=13 D EN3^DGPTFJC I 'DGER" "^DD",45,45,79.243,21,0) ^.001^1^1^3040115^^^^ "^DD",45,45,79.243,21,1,0) This field contains a diagnosis for the patient during this episode of care. "^DD",45,45,79.243,"DT") 3050324 "^DD",45,45,79.244,0) SECONDARY DIAGNOSIS 13^P80'^ICD9(^71;4^Q "^DD",45,45,79.244,1,0) ^.1 "^DD",45,45,79.244,1,1,0) 45^ADGRU79244^MUMPS "^DD",45,45,79.244,1,1,1) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.244,1,1,2) N DG1 S DG1=$P(^DGPT(DA,0),"^",1) N X S X="DGRUDD01" X ^%ZOSF("TEST") Q:'$T D:(+DG1>0) ADGRU^DGRUDD01(DG1) "^DD",45,45,79.244,1,1,"%D",0) ^^1^1^3050324^ "^DD",45,45,79.244,1,1,"%D",1,0) Create a ADT/HL7 PIVOT (#391.71) entry when diagnosis changes "^DD",45,45,79.244,1,1,"DT") 3050324 "^DD",45,45,79.244,"DT") 3050324 **END** **END**