KIDS Distribution saved on Nov 12, 2004@15:34:15 Ambcare Inpatient Transmission DG*5.3*617 & SD*5.3*387 **KIDS**:AMBCARE IP 1.0^DG*5.3*617^SD*5.3*387^ **INSTALL NAME** AMBCARE IP 1.0 "BLD",4958,0) AMBCARE IP 1.0^^1^3041112^y "BLD",4958,10,0) ^9.63^2^2 "BLD",4958,10,1,0) DG*5.3*617^1 "BLD",4958,10,2,0) SD*5.3*387^1 "BLD",4958,10,"B","DG*5.3*617",1) "BLD",4958,10,"B","SD*5.3*387",2) "BLD",4958,"KRN",0) ^9.67PA^8989.52^19 "BLD",4958,"KRN",.4,0) .4 "BLD",4958,"KRN",.401,0) .401 "BLD",4958,"KRN",.402,0) .402 "BLD",4958,"KRN",.403,0) .403 "BLD",4958,"KRN",.5,0) .5 "BLD",4958,"KRN",.84,0) .84 "BLD",4958,"KRN",3.6,0) 3.6 "BLD",4958,"KRN",3.8,0) 3.8 "BLD",4958,"KRN",9.2,0) 9.2 "BLD",4958,"KRN",9.8,0) 9.8 "BLD",4958,"KRN",19,0) 19 "BLD",4958,"KRN",19.1,0) 19.1 "BLD",4958,"KRN",101,0) 101 "BLD",4958,"KRN",409.61,0) 409.61 "BLD",4958,"KRN",771,0) 771 "BLD",4958,"KRN",870,0) 870 "BLD",4958,"KRN",8989.51,0) 8989.51 "BLD",4958,"KRN",8989.52,0) 8989.52 "BLD",4958,"KRN",8994,0) 8994 "BLD",4958,"KRN","B",.4,.4) "BLD",4958,"KRN","B",.401,.401) "BLD",4958,"KRN","B",.402,.402) "BLD",4958,"KRN","B",.403,.403) "BLD",4958,"KRN","B",.5,.5) "BLD",4958,"KRN","B",.84,.84) "BLD",4958,"KRN","B",3.6,3.6) "BLD",4958,"KRN","B",3.8,3.8) "BLD",4958,"KRN","B",9.2,9.2) "BLD",4958,"KRN","B",9.8,9.8) "BLD",4958,"KRN","B",19,19) "BLD",4958,"KRN","B",19.1,19.1) "BLD",4958,"KRN","B",101,101) "BLD",4958,"KRN","B",409.61,409.61) "BLD",4958,"KRN","B",771,771) "BLD",4958,"KRN","B",870,870) "BLD",4958,"KRN","B",8989.51,8989.51) "BLD",4958,"KRN","B",8989.52,8989.52) "BLD",4958,"KRN","B",8994,8994) "MBREQ") 0 "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 "VER") 8.0^22.0 **INSTALL NAME** DG*5.3*617 "BLD",4946,0) DG*5.3*617^REGISTRATION^0^3041112^y "BLD",4946,4,0) ^9.64PA^^ "BLD",4946,"ABPKG") n "BLD",4946,"KRN",0) ^9.67PA^8989.52^19 "BLD",4946,"KRN",.4,0) .4 "BLD",4946,"KRN",.401,0) .401 "BLD",4946,"KRN",.402,0) .402 "BLD",4946,"KRN",.403,0) .403 "BLD",4946,"KRN",.5,0) .5 "BLD",4946,"KRN",.84,0) .84 "BLD",4946,"KRN",3.6,0) 3.6 "BLD",4946,"KRN",3.8,0) 3.8 "BLD",4946,"KRN",9.2,0) 9.2 "BLD",4946,"KRN",9.8,0) 9.8 "BLD",4946,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",4946,"KRN",9.8,"NM",1,0) VAFHLPV1^^0^B23785665 "BLD",4946,"KRN",9.8,"NM",2,0) DG3PR2^^0^B16048519 "BLD",4946,"KRN",9.8,"NM","B","DG3PR2",2) "BLD",4946,"KRN",9.8,"NM","B","VAFHLPV1",1) "BLD",4946,"KRN",19,0) 19 "BLD",4946,"KRN",19.1,0) 19.1 "BLD",4946,"KRN",101,0) 101 "BLD",4946,"KRN",409.61,0) 409.61 "BLD",4946,"KRN",771,0) 771 "BLD",4946,"KRN",870,0) 870 "BLD",4946,"KRN",8989.51,0) 8989.51 "BLD",4946,"KRN",8989.52,0) 8989.52 "BLD",4946,"KRN",8994,0) 8994 "BLD",4946,"KRN","B",.4,.4) "BLD",4946,"KRN","B",.401,.401) "BLD",4946,"KRN","B",.402,.402) "BLD",4946,"KRN","B",.403,.403) "BLD",4946,"KRN","B",.5,.5) "BLD",4946,"KRN","B",.84,.84) "BLD",4946,"KRN","B",3.6,3.6) "BLD",4946,"KRN","B",3.8,3.8) "BLD",4946,"KRN","B",9.2,9.2) "BLD",4946,"KRN","B",9.8,9.8) "BLD",4946,"KRN","B",19,19) "BLD",4946,"KRN","B",19.1,19.1) "BLD",4946,"KRN","B",101,101) "BLD",4946,"KRN","B",409.61,409.61) "BLD",4946,"KRN","B",771,771) "BLD",4946,"KRN","B",870,870) "BLD",4946,"KRN","B",8989.51,8989.51) "BLD",4946,"KRN","B",8989.52,8989.52) "BLD",4946,"KRN","B",8994,8994) "BLD",4946,"QUES",0) ^9.62^^ "BLD",4946,"REQB",0) ^9.611^3^3 "BLD",4946,"REQB",1,0) DG*5.3*298^2 "BLD",4946,"REQB",2,0) DG*5.3*511^2 "BLD",4946,"REQB",3,0) DG*5.3*606^2 "BLD",4946,"REQB","B","DG*5.3*298",1) "BLD",4946,"REQB","B","DG*5.3*511",2) "BLD",4946,"REQB","B","DG*5.3*606",3) "MBREQ") 1 "PKG",114,-1) 1^1 "PKG",114,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",114,20,0) ^9.402P^^ "PKG",114,22,0) ^9.49I^1^1 "PKG",114,22,1,0) 5.3^2930813^2930821 "PKG",114,22,1,"PAH",1,0) 617^3041112^11724 "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") 2 "RTN","DG3PR2") 0^2^B16048519 "RTN","DG3PR2",1,0) DG3PR2 ;ALB/MIR - CONTINUATION OF THE THIRD PARTY REIMBURSEMENT ; NOV 21 90@8 "RTN","DG3PR2",2,0) ;;5.3;Registration;**26,606,617**;Aug 13, 1993 "RTN","DG3PR2",3,0) S DGINS=0 W !!,"INSURANCE TYPE",?24,"INSURANCE #",?45,"GROUP #",?63,"EXPIRES HOLDER",!,"--------- ----",?24,"--------- -",?45,"----- -",?63,"------- ------" "RTN","DG3PR2",4,0) D ALL^IBCNS1(DFN,"DGIBINS") F I=0:0 S I=$O(DGIBINS(I)) Q:'I S J=DGIBINS(I,0) S X=$G(^DIC(36,+J,0)) W !,$S($P(X,"^",2)="N":"*",1:""),$E($P(X,"^",1),1,22),?24,$P(J,"^",2),?45,$P(J,"^",3) S DGINS=$S($P(X,"^",2)="N":1,1:0) D INS2 "RTN","DG3PR2",5,0) I DGINS W !?22,"* - Insurer may not reimburse!" "RTN","DG3PR2",6,0) K DGINS,DGIBINS "RTN","DG3PR2",7,0) S Y=+DGAD X ^DD("DD") W !!,"Admitted: ",Y,?40,"Discharged: " S Y=+DGDC I Y X ^DD("DD") W Y "RTN","DG3PR2",8,0) I $P(DGAD,"^",18)=9 W !,"Transferred in From ",$S($D(^DIC(4,+$P(DGAD,"^",5),0)):$P(^(0),"^",1),1:"") "RTN","DG3PR2",9,0) S DGPTF=$P(DGAD,"^",16) I 'DGPTF!('$D(^DGPT(+DGPTF,0))) W !,"No PTF Record Exists" Q "RTN","DG3PR2",10,0) I '$D(^DGP(45.84,DGPTF)) W !,"PTF Record not closed",! "RTN","DG3PR2",11,0) K ^UTILITY("DG") F I=0:0 S I=$O(^DGPT(DGPTF,"M",I)) Q:'I S J=^(I,0) S:$P(J,"^",2) ^UTILITY("DG",$J,"M",+$P(J,"^",10))=J "RTN","DG3PR2",12,0) F I=0:0 S I=$O(^DGPT(DGPTF,"S",I)) Q:'I D HEAD:$Y>(IOSL-5) Q:'DGFL S J=^DGPT(DGPTF,"S",I,0),^UTILITY("DG",$J,"S",+J)=J "RTN","DG3PR2",13,0) Q:'DGFL I $O(^UTILITY("DG",$J,"M",0)) W !!,"DATE",?22,"LOS BEDSECTION",?39,"LOS",?45,"DIAGNOSES",!,"----",?22,"---------------",?39,"---- ---------" "RTN","DG3PR2",14,0) N DGDAT,DXD "RTN","DG3PR2",15,0) S DGDAT=$P(^DGPT(DGPTF,0),"^",2) "RTN","DG3PR2",16,0) S DGPR=DGAD F I=0:0 S I=$O(^UTILITY("DG",$J,"M",I)) Q:'I S J=^(I) D HEAD:$Y>(IOSL-5) Q:'DGFL S (DGDAT,Y)=I X ^DD("DD") D LOL W !,Y,?22,$E($S($D(^DIC(42.4,+$P(J,"^",2),0)):$P(^(0),"^",1),1:""),1,16),?39,$J(DGLOL,4) D DIAG S DGPR=I "RTN","DG3PR2",17,0) ;Q:'DGFL S DGPMIFN=DGCA D ^DGPMLOS W !?39,"---- ----------",!?26,"TOTAL LOS:",?39,$J(+$P(X,"^",5),4),?45,$S($D(^ICD9(+$S($D(^DGPT(DGPTF,70)):$P(^(70),"^",10),1:""),0)):"DXLS: "_$P(^(0),"^",1)_" ("_$P(^(0),"^",3)_")",1:"") "RTN","DG3PR2",18,0) Q:'DGFL S DGPMIFN=DGCA "RTN","DG3PR2",19,0) D ^DGPMLOS W !?39,"---- ----------",!?26,"TOTAL LOS:",?39,$J(+$P(X,"^",5),4) S DXD=+$S($D(^DGPT(DGPTF,70)):$P(^(70),"^",10),1:0),DXD=$S(+DXD:$$ICDDX^ICDCODE(DXD,DGDAT),1:"") W ?45,$S(+DXD>0:"DXLS: "_$P(DXD,"^",2)_" ("_$P(DXD,"^",4)_")",1:"") "RTN","DG3PR2",20,0) Q:'$O(^UTILITY("DG",$J,"S",0)) D HEAD:$Y>(IOSL-10) Q:'DGFL W !!,"SURGERY DATE",?22,"SPECIALTY",?45,"OP CODES",!,"------------",?22,"----------",?44,"--------" "RTN","DG3PR2",21,0) F I=0:0 S I=$O(^UTILITY("DG",$J,"S",I)) Q:'I S J=^(I),(DGDAT,Y)=I X ^DD("DD") W !,Y,?22,$E($S($D(^DIC(45.3,+$P(J,"^",3),0)):$P(^(0),"^",2),1:""),1,16) D OP "RTN","DG3PR2",22,0) Q "RTN","DG3PR2",23,0) DIAG S M=0 F K=5:1:15 I K'=10 S L=$P(J,"^",K) I L S DXD=$$ICDDX^ICDCODE(+L,$G(DGDAT)) W:M ! W ?45,$S(+DXD>0:$P(DXD,"^",2)_" ("_$P(DXD,"^",4)_")",1:"") S M=1 "RTN","DG3PR2",24,0) Q "RTN","DG3PR2",25,0) OP S M=0 F K=8:1:12 S L=$P(J,"^",K) I L S DXD=$$ICDOP^ICDCODE(+L,$G(DGDAT)) W:M ! W ?45,$S(+DXD>0:$P(DXD,"^",2)_" ("_$P(DXD,"^",5)_")",1:"") S M=1 "RTN","DG3PR2",26,0) Q "RTN","DG3PR2",27,0) LOL S X1=I,X2=DGPR D DTC S DGLOL=X "RTN","DG3PR2",28,0) F K=DGPR+.0000005:0 S K=$O(^DGPM("APCA",DFN,DGCA,K)) Q:'K!(K>I) S C=$O(^(+K,0)) I $D(^DGPM(+C,0)),"^2^3^13^43^44^45^"[("^"_$P(^(0),"^",18)_"^") S X1=$O(^DGPM("APCA",DFN,DGCA,K)),X1=$S('X1:I,X1>I:I,1:X1),X2=K D DTC S DGLOL=DGLOL-X "RTN","DG3PR2",29,0) Q "RTN","DG3PR2",30,0) HEAD N I,J,K,L,M,Y I $E(IOST,1)="C" S DIR(0)="E" D ^DIR S DGFL=Y I 'DGFL Q "RTN","DG3PR2",31,0) W @IOF,!,"THIRD PARTY REIMBURSEMENT",?49,"PRINTED: ",DGNOW "RTN","DG3PR2",32,0) W !,"("_$P(^DPT(DFN,0),"^",1)_")",! "RTN","DG3PR2",33,0) Q "RTN","DG3PR2",34,0) INS2 ;insurance data continued "RTN","DG3PR2",35,0) I $P(X,"^",2)="N" S DGINS=1 "RTN","DG3PR2",36,0) S X=$P(J,"^",4) W:X]"" ?63,$E(X,4,5),"/",$E(X,6,7),"/",$E(X,2,3) S X=$P(J,"^",6) W ?73,$S(X="v":"VETERAN",X="s":"SPOUSE",X="o":"OTHER",1:"UNKNOWN") "RTN","DG3PR2",37,0) Q "RTN","DG3PR2",38,0) DTC N I,J,K,L,M,Y D ^%DTC Q "RTN","VAFHLPV1") 0^1^B23785665 "RTN","VAFHLPV1",1,0) VAFHLPV1 ;ALB/CM/ESD HL7 PV1 SEGMENT BUILDING ;06/08/00 "RTN","VAFHLPV1",2,0) ;;5.3;Registration;**94,106,151,298,617**;Aug 13, 1993 "RTN","VAFHLPV1",3,0) ; "RTN","VAFHLPV1",4,0) ;This routine will build an HL7 PV1 segment for an inpatient or "RTN","VAFHLPV1",5,0) ;outpatient event depending on the entry point used. "RTN","VAFHLPV1",6,0) ;Use IN for inpatient "RTN","VAFHLPV1",7,0) ;Use OUT for outpatient "RTN","VAFHLPV1",8,0) ; "RTN","VAFHLPV1",9,0) IN(DFN,VAFHDT,VAFSTR,IEN,PIVOT,SETID,VAFDIAG) ; "RTN","VAFHLPV1",10,0) N RESULT "RTN","VAFHLPV1",11,0) S RESULT=$$EN^VAFHAPV1(DFN,VAFHDT,VAFSTR,IEN,PIVOT,SETID,.VAFDIAG) "RTN","VAFHLPV1",12,0) Q $G(RESULT) "RTN","VAFHLPV1",13,0) ; "RTN","VAFHLPV1",14,0) OUT(DFN,EVT,EVDTS,VPTR,STRP,NUMP) ; "RTN","VAFHLPV1",15,0) ;DFN - Patient File "RTN","VAFHLPV1",16,0) ;EVT - event number from pivot file "RTN","VAFHLPV1",17,0) ;EVDTS - event date/time in FileMan format "RTN","VAFHLPV1",18,0) ;VPTR - variable pointer "RTN","VAFHLPV1",19,0) ;STRP - string of fields (if null - required fields, if "A" - supported "RTN","VAFHLPV1",20,0) ;fields, or string of fields seperated by commas") "RTN","VAFHLPV1",21,0) ;NUMP - ID # (optional) "RTN","VAFHLPV1",22,0) ; "RTN","VAFHLPV1",23,0) N ERR "RTN","VAFHLPV1",24,0) I '$D(NUMP) S NUMP=1 "RTN","VAFHLPV1",25,0) S ERR=$$OPV1^VAFHCPV($G(DFN),$G(EVT),$G(EVDTS),$G(VPTR),$G(STRP),NUMP) "RTN","VAFHLPV1",26,0) Q ERR "RTN","VAFHLPV1",27,0) KVAR ; "RTN","VAFHLPV1",28,0) K VAFHLPV1 "RTN","VAFHLPV1",29,0) Q "RTN","VAFHLPV1",30,0) ; "RTN","VAFHLPV1",31,0) EN(VAFENC,VAFDENC,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS) ; "RTN","VAFHLPV1",32,0) ; Entry point for Ambulatory Care Database Project "RTN","VAFHLPV1",33,0) ; "RTN","VAFHLPV1",34,0) ; Entry point to return the HL7 PV1 (Patient Visit) segment "RTN","VAFHLPV1",35,0) ; "RTN","VAFHLPV1",36,0) ; Input: VAFENC - Outpatient Encounter IEN (pointer to Outpatient "RTN","VAFHLPV1",37,0) ; Encounter file #409.68) "RTN","VAFHLPV1",38,0) ; "RTN","VAFHLPV1",39,0) ; VAFDENC - Deleted Outpatient Encounter IEN (pointer to "RTN","VAFHLPV1",40,0) ; Deleted Outpatient Encounter file #409.74) "RTN","VAFHLPV1",41,0) ; "RTN","VAFHLPV1",42,0) ; VAFSTR - String of fields requested separated by commas "RTN","VAFHLPV1",43,0) ; "RTN","VAFHLPV1",44,0) ; VAFNUM - Set ID (sequential number - default=1) "RTN","VAFHLPV1",45,0) ; "RTN","VAFHLPV1",46,0) ; VAFHLQ - Optional HL7 null variable. If not there, use "RTN","VAFHLPV1",47,0) ; default HL7 variable. "RTN","VAFHLPV1",48,0) ; "RTN","VAFHLPV1",49,0) ; VAFHLFS - Optional HL7 field separator. If not there, use "RTN","VAFHLPV1",50,0) ; default HL7 variable. "RTN","VAFHLPV1",51,0) ; "RTN","VAFHLPV1",52,0) ; Output: String containing desired components of the PV1 segment "RTN","VAFHLPV1",53,0) ; "RTN","VAFHLPV1",54,0) ; NOTE: Data for the PV1 segment will be retrieved from either the "RTN","VAFHLPV1",55,0) ; Outpatient Encounter file (#409.68) or Deleted Outpatient "RTN","VAFHLPV1",56,0) ; Encounter (#409.74) based on the pointer parameter passed in. "RTN","VAFHLPV1",57,0) ; "RTN","VAFHLPV1",58,0) ;06/08/2000 ACS - AMBCARE PV1 CHANGES: "RTN","VAFHLPV1",59,0) ; 1. SET UP HL7 DEFAULT VARIABLES AT BEGINNING OF SUBROUTINE. "RTN","VAFHLPV1",60,0) ; 2. VALIDATE EXISTENCE OF AMBCARE ENCOUNTER. "RTN","VAFHLPV1",61,0) ; 3. ALWAYS RETURN PATIENT CLASS IN SEGMENT. "RTN","VAFHLPV1",62,0) ; "RTN","VAFHLPV1",63,0) ; "RTN","VAFHLPV1",64,0) N VAFAPTYP,VAFCLIN,VAFDAT,VAFDFN,VAFFLG,VAFNODE,VAFNODE1,VAFORIG,VAFPTCL,VAFY,X,VAINVENC,VAFPSTAT,VAFPIN "RTN","VAFHLPV1",65,0) ; "RTN","VAFHLPV1",66,0) ; - If VAFHLQ or VAFHLFS aren't passed in, use default HL7 variables. "RTN","VAFHLPV1",67,0) S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS)) "RTN","VAFHLPV1",68,0) ; "RTN","VAFHLPV1",69,0) ;- Sequential Number "RTN","VAFHLPV1",70,0) S $P(VAFY,VAFHLFS,1)=$S($G(VAFNUM):VAFNUM,1:1) "RTN","VAFHLPV1",71,0) ; "RTN","VAFHLPV1",72,0) S VAFPTCL="O" ; Patient Class = Outpatient "RTN","VAFHLPV1",73,0) ; "RTN","VAFHLPV1",74,0) ;- Set patient class in segment "RTN","VAFHLPV1",75,0) S $P(VAFY,VAFHLFS,2)=VAFPTCL "RTN","VAFHLPV1",76,0) ; "RTN","VAFHLPV1",77,0) ;- If encounter or variable string missing, pass back incomplete segment "RTN","VAFHLPV1",78,0) I ($G(VAFENC)=""&($G(VAFDENC)=""))!($G(VAFSTR)="") G ENQ "RTN","VAFHLPV1",79,0) ; "RTN","VAFHLPV1",80,0) ; - If regular encounter doesn't exist, pass back incomplete segment "RTN","VAFHLPV1",81,0) I $G(VAFENC) D G:$G(VAINVENC) ENQ "RTN","VAFHLPV1",82,0) . I '$D(^SCE($G(VAFENC))) S VAINVENC=1 "RTN","VAFHLPV1",83,0) ; "RTN","VAFHLPV1",84,0) ; - If deleted encounter doesn't exist, pass back incomplete segment "RTN","VAFHLPV1",85,0) I $G(VAFDENC) D G:$G(VAINVENC) ENQ "RTN","VAFHLPV1",86,0) . I '$D(^SD(409.74,$G(VAFDENC))) S VAINVENC=1 "RTN","VAFHLPV1",87,0) ; "RTN","VAFHLPV1",88,0) S VAFENC=+$G(VAFENC),VAFDENC=+$G(VAFDENC) "RTN","VAFHLPV1",89,0) S $P(VAFY,VAFHLFS,50)="",VAFSTR=","_VAFSTR_"," "RTN","VAFHLPV1",90,0) ; "RTN","VAFHLPV1",91,0) ; - Set flag to indicate whether Outpatient Encounter ("E") or Deleted "RTN","VAFHLPV1",92,0) ; Outpatient Encounter ("D"). "RTN","VAFHLPV1",93,0) S VAFFLG=$S(VAFENC:"E",1:"D") "RTN","VAFHLPV1",94,0) ; "RTN","VAFHLPV1",95,0) I VAFFLG="E" S VAFNODE=$$SCE^DGSDU(VAFENC) "RTN","VAFHLPV1",96,0) ; "RTN","VAFHLPV1",97,0) ; - VAFNODE1 = old encounter zero node for deleted encounter "RTN","VAFHLPV1",98,0) I VAFFLG="D" D "RTN","VAFHLPV1",99,0) . S VAFNODE=$G(^SD(409.74,VAFDENC,0)) "RTN","VAFHLPV1",100,0) . S VAFNODE1=$G(^SD(409.74,VAFDENC,1)) "RTN","VAFHLPV1",101,0) ; "RTN","VAFHLPV1",102,0) ;- Reset patient class/status if Inpatient "RTN","VAFHLPV1",103,0) S VAFPSTAT=$$INPATENC^SCDXUTL($S(VAFFLG="E":VAFENC,1:VAFDENC),$S(VAFFLG="E":1,1:2)) "RTN","VAFHLPV1",104,0) I VAFPSTAT S VAFPTCL="I" S $P(VAFY,VAFHLFS,2)=VAFPTCL "RTN","VAFHLPV1",105,0) ; "RTN","VAFHLPV1",106,0) ;- Purpose of Visit "RTN","VAFHLPV1",107,0) I VAFSTR[",4," D "RTN","VAFHLPV1",108,0) . S VAFDAT=$P(VAFNODE,"^"),VAFDFN=$P(VAFNODE,"^",2) "RTN","VAFHLPV1",109,0) . S VAFCLIN=$S(VAFFLG="E":$P(VAFNODE,"^",4),1:$P(VAFNODE1,"^",4)) "RTN","VAFHLPV1",110,0) . S VAFAPTYP=$S(VAFFLG="E":$P(VAFNODE,"^",10),1:$P(VAFNODE1,"^",10)) "RTN","VAFHLPV1",111,0) . S X=$$POV^SCDXUTL0(VAFDFN,VAFDAT,VAFCLIN,VAFAPTYP) "RTN","VAFHLPV1",112,0) . I X="" D "RTN","VAFHLPV1",113,0) .. S VAFORIG=$S(VAFFLG="E":$P(VAFNODE,"^",8),1:$P(VAFNODE1,"^",8)) "RTN","VAFHLPV1",114,0) .. S X=$S(VAFORIG=2:"04"_$S($L(VAFAPTYP)=1:"0"_VAFAPTYP,1:VAFAPTYP),VAFORIG=3:"02"_$S($L(VAFAPTYP)=1:"0"_VAFAPTYP,1:VAFAPTYP),1:"") "RTN","VAFHLPV1",115,0) . S $P(VAFY,VAFHLFS,4)=$S(X]"":X,1:VAFHLQ) "RTN","VAFHLPV1",116,0) ; "RTN","VAFHLPV1",117,0) ;- Location of Visit "RTN","VAFHLPV1",118,0) I VAFSTR[",14," D "RTN","VAFHLPV1",119,0) . S VAFCLIN=$S(VAFFLG="E":$P(VAFNODE,"^",4),1:$P(VAFNODE1,"^",4)) "RTN","VAFHLPV1",120,0) . S X=$P($G(^SC(+VAFCLIN,0)),"^",19),X=$S(X="Y":1,X="N":6,1:"") "RTN","VAFHLPV1",121,0) . I X="" S VAFORIG=$S(VAFFLG="E":$P(VAFNODE,"^",8),1:$P(VAFNODE1,"^",8)),X=$S(VAFORIG=2!(VAFORIG=3):1,1:"") "RTN","VAFHLPV1",122,0) . S $P(VAFY,VAFHLFS,14)=$S(X]"":X,1:VAFHLQ) "RTN","VAFHLPV1",123,0) ; "RTN","VAFHLPV1",124,0) ;- Outpatient Encounter IEN (not passed for deleted outpat encounter) "RTN","VAFHLPV1",125,0) I VAFSTR[",19," S $P(VAFY,VAFHLFS,19)=$S(VAFFLG="E":VAFENC,1:VAFHLQ) "RTN","VAFHLPV1",126,0) ; "RTN","VAFHLPV1",127,0) ;- Facility Number and Suffix "RTN","VAFHLPV1",128,0) I VAFSTR[",39," D "RTN","VAFHLPV1",129,0) . ; add division parameter to $$SITE^VASITE call ; abr "RTN","VAFHLPV1",130,0) . S X=$S(VAFFLG="E":$$SITE^VASITE($P(VAFNODE,"^"),$P(VAFNODE,"^",11)),1:$$SITE^VASITE($P(VAFNODE1,"^"),$P(VAFNODE1,"^",11))) "RTN","VAFHLPV1",131,0) . S X=$P(X,"^",3) "RTN","VAFHLPV1",132,0) . S $P(VAFY,VAFHLFS,39)=$S(X]"":X,1:VAFHLQ) "RTN","VAFHLPV1",133,0) ; "RTN","VAFHLPV1",134,0) ;- Encounter Date/Time for Outpatients & Admission Date for Inpatients "RTN","VAFHLPV1",135,0) I VAFSTR[",44," D "RTN","VAFHLPV1",136,0) . N DFN,VAIN "RTN","VAFHLPV1",137,0) . S VAFPIN=0 "RTN","VAFHLPV1",138,0) . I VAFPSTAT S VAFPIN=$S(VAFFLG="E":$P(VAFNODE,"^",2),1:$P(VAFNODE1,"^",2)) I VAFPIN S DFN=VAFPIN D INP^VADPT S X=$P(VAIN(7),"^") I 'X S VAFPIN=0 "RTN","VAFHLPV1",139,0) . I 'VAFPIN S X=$S(VAFFLG="E":$P(VAFNODE,"^"),1:$P(VAFNODE1,"^")) "RTN","VAFHLPV1",140,0) . S X=$$HLDATE^HLFNC(X) "RTN","VAFHLPV1",141,0) . S $P(VAFY,VAFHLFS,44)=$S(X]"":X,1:VAFHLQ) "RTN","VAFHLPV1",142,0) ; "RTN","VAFHLPV1",143,0) ;- Unique Identifier (PCE) "RTN","VAFHLPV1",144,0) I VAFSTR[",50," D "RTN","VAFHLPV1",145,0) . S X=$S(VAFFLG="E":$P(VAFNODE,"^",20),1:$P(VAFNODE1,"^",20)) "RTN","VAFHLPV1",146,0) . S $P(VAFY,VAFHLFS,50)=$S(X]"":X,1:VAFHLQ) "RTN","VAFHLPV1",147,0) ; "RTN","VAFHLPV1",148,0) ENQ Q "PV1"_VAFHLFS_$G(VAFY) "VER") 8.0^22.0 **INSTALL NAME** SD*5.3*387 "BLD",4945,0) SD*5.3*387^SCHEDULING^0^3041112^y "BLD",4945,4,0) ^9.64PA^^ "BLD",4945,"INID") ^y "BLD",4945,"INIT") SD53P387 "BLD",4945,"KRN",0) ^9.67PA^8989.52^19 "BLD",4945,"KRN",.4,0) .4 "BLD",4945,"KRN",.401,0) .401 "BLD",4945,"KRN",.402,0) .402 "BLD",4945,"KRN",.403,0) .403 "BLD",4945,"KRN",.5,0) .5 "BLD",4945,"KRN",.84,0) .84 "BLD",4945,"KRN",3.6,0) 3.6 "BLD",4945,"KRN",3.8,0) 3.8 "BLD",4945,"KRN",9.2,0) 9.2 "BLD",4945,"KRN",9.8,0) 9.8 "BLD",4945,"KRN",9.8,"NM",0) ^9.68A^7^7 "BLD",4945,"KRN",9.8,"NM",1,0) SCDXMSG^^0^B44667997 "BLD",4945,"KRN",9.8,"NM",2,0) SCMSVUT1^^0^B65985223 "BLD",4945,"KRN",9.8,"NM",3,0) SCMSVPV1^^0^B6609913 "BLD",4945,"KRN",9.8,"NM",4,0) SCDXMSG1^^0^B73454868 "BLD",4945,"KRN",9.8,"NM",5,0) SCDXMSG0^^0^B24954393 "BLD",4945,"KRN",9.8,"NM",6,0) SDAMBMR2^^0^B25248772 "BLD",4945,"KRN",9.8,"NM",7,0) SCRPW18^^0^B55681496 "BLD",4945,"KRN",9.8,"NM","B","SCDXMSG",1) "BLD",4945,"KRN",9.8,"NM","B","SCDXMSG0",5) "BLD",4945,"KRN",9.8,"NM","B","SCDXMSG1",4) "BLD",4945,"KRN",9.8,"NM","B","SCMSVPV1",3) "BLD",4945,"KRN",9.8,"NM","B","SCMSVUT1",2) "BLD",4945,"KRN",9.8,"NM","B","SCRPW18",7) "BLD",4945,"KRN",9.8,"NM","B","SDAMBMR2",6) "BLD",4945,"KRN",19,0) 19 "BLD",4945,"KRN",19.1,0) 19.1 "BLD",4945,"KRN",101,0) 101 "BLD",4945,"KRN",409.61,0) 409.61 "BLD",4945,"KRN",771,0) 771 "BLD",4945,"KRN",870,0) 870 "BLD",4945,"KRN",8989.51,0) 8989.51 "BLD",4945,"KRN",8989.52,0) 8989.52 "BLD",4945,"KRN",8994,0) 8994 "BLD",4945,"KRN","B",.4,.4) "BLD",4945,"KRN","B",.401,.401) "BLD",4945,"KRN","B",.402,.402) "BLD",4945,"KRN","B",.403,.403) "BLD",4945,"KRN","B",.5,.5) "BLD",4945,"KRN","B",.84,.84) "BLD",4945,"KRN","B",3.6,3.6) "BLD",4945,"KRN","B",3.8,3.8) "BLD",4945,"KRN","B",9.2,9.2) "BLD",4945,"KRN","B",9.8,9.8) "BLD",4945,"KRN","B",19,19) "BLD",4945,"KRN","B",19.1,19.1) "BLD",4945,"KRN","B",101,101) "BLD",4945,"KRN","B",409.61,409.61) "BLD",4945,"KRN","B",771,771) "BLD",4945,"KRN","B",870,870) "BLD",4945,"KRN","B",8989.51,8989.51) "BLD",4945,"KRN","B",8989.52,8989.52) "BLD",4945,"KRN","B",8994,8994) "BLD",4945,"QUES",0) ^9.62^^ "BLD",4945,"REQB",0) ^9.611^7^6 "BLD",4945,"REQB",1,0) SD*5.3*245^2 "BLD",4945,"REQB",3,0) SD*5.3*295^2 "BLD",4945,"REQB",4,0) SD*5.3*341^2 "BLD",4945,"REQB",5,0) SD*5.3*325^2 "BLD",4945,"REQB",6,0) SD*5.3*339^2 "BLD",4945,"REQB",7,0) SD*5.3*351^2 "BLD",4945,"REQB","B","SD*5.3*245",1) "BLD",4945,"REQB","B","SD*5.3*295",3) "BLD",4945,"REQB","B","SD*5.3*325",5) "BLD",4945,"REQB","B","SD*5.3*339",6) "BLD",4945,"REQB","B","SD*5.3*341",4) "BLD",4945,"REQB","B","SD*5.3*351",7) "INIT") SD53P387 "MBREQ") 1 "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,20,0) ^9.402P^^ "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930824 "PKG",16,22,1,"PAH",1,0) 387^3041112^11724 "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") 8 "RTN","SCDXMSG") 0^1^B44667997 "RTN","SCDXMSG",1,0) SCDXMSG ;ALB/JRP - AMB CARE TRANSMISSION BUILDER;06-MAY-1996 ; 12/20/01 4:46pm "RTN","SCDXMSG",2,0) ;;5.3;Scheduling;**44,56,70,77,85,96,121,128,66,247,245,387**;AUG 13, 1993 "RTN","SCDXMSG",3,0) ; "RTN","SCDXMSG",4,0) SNDZ00 ;Main entry point for the sending of ADT-Z00 batch messages to "RTN","SCDXMSG",5,0) ; the National Patient Care Database "RTN","SCDXMSG",6,0) ; "RTN","SCDXMSG",7,0) ;Input : None "RTN","SCDXMSG",8,0) ;Output : None "RTN","SCDXMSG",9,0) ; "RTN","SCDXMSG",10,0) SD70 ; added w/ patch SD*5.3*70 to reset transmit flags if needed "RTN","SCDXMSG",11,0) N SDEND,SDSTA D EN^SCDXUTL5 "RTN","SCDXMSG",12,0) ; "RTN","SCDXMSG",13,0) ;Declare variables "RTN","SCDXMSG",14,0) N X,X1,X2,%H "RTN","SCDXMSG",15,0) N XMITPTR,NOACKBY,XMITDATE,SCDXEVNT,MAXBATCH,MAXLINE,BATCHCNT,MSGNUM "RTN","SCDXMSG",16,0) N LINECNT,MSHLINE,XMITLIST,XMITERR,HL7XMIT,ERROR "RTN","SCDXMSG",17,0) N HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP "RTN","SCDXMSG",18,0) ;Set message count limit for batch message "RTN","SCDXMSG",19,0) S MAXBATCH=100 "RTN","SCDXMSG",20,0) ;Set line count limit for batch message Note max 160K char. MM Message "RTN","SCDXMSG",21,0) S MAXLINE=$P($G(^SD(404.91,1,"AMB")),U,8) S:'MAXLINE MAXLINE=2000 "RTN","SCDXMSG",22,0) ;Initialize global locations "RTN","SCDXMSG",23,0) S XMITERR="^TMP(""SCDX-XMIT-BLD"","_$J_",""ERRORS"")" "RTN","SCDXMSG",24,0) S HL7XMIT="^TMP(""HLS"","_$J_")" "RTN","SCDXMSG",25,0) K @XMITERR,@HL7XMIT "RTN","SCDXMSG",26,0) ;Get lag time for acks from NPCDB (default to T-LAG) "RTN","SCDXMSG",27,0) S NOACKBY=+$P($G(^SD(404.91,1,"AMB")),"^",4) "RTN","SCDXMSG",28,0) S:('NOACKBY) NOACKBY=2 "RTN","SCDXMSG",29,0) ;Determine T-LAG @ 11:59:59 PM "RTN","SCDXMSG",30,0) S X1=$$DT^XLFDT() "RTN","SCDXMSG",31,0) S X2=0-NOACKBY "RTN","SCDXMSG",32,0) S NOACKBY=$$FMADD^XLFDT(X1,X2)_".235959" "RTN","SCDXMSG",33,0) ;Flag transmissions that haven't been acked by T-LAG for retransmission "RTN","SCDXMSG",34,0) S XMITDATE="" "RTN","SCDXMSG",35,0) F S XMITDATE=+$O(^SD(409.73,"AACNOACK",XMITDATE)) Q:(('XMITDATE)!(XMITDATE>NOACKBY)) D "RTN","SCDXMSG",36,0) .S XMITPTR="" "RTN","SCDXMSG",37,0) .F S XMITPTR=+$O(^SD(409.73,"AACNOACK",XMITDATE,XMITPTR)) Q:('XMITPTR) D "RTN","SCDXMSG",38,0) ..;Mark entry with retransmit event (POSTMASTER is causer of event) "RTN","SCDXMSG",39,0) ..D STREEVNT^SCDXFU01(XMITPTR,0,"",.5) "RTN","SCDXMSG",40,0) ..;Can no longer receive database credit - delete x-ref and quit "RTN","SCDXMSG",41,0) ..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 K ^SD(409.73,"AACNOACK",XMITDATE,XMITPTR) Q ;SD*5.3*247 "RTN","SCDXMSG",42,0) ..;Turn transmission flag on "RTN","SCDXMSG",43,0) ..D XMITFLAG^SCDXFU01(XMITPTR) "RTN","SCDXMSG",44,0) ;Get pointer to sending event "RTN","SCDXMSG",45,0) S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0)) "RTN","SCDXMSG",46,0) ;Sending event not found - send error bulletin - done "RTN","SCDXMSG",47,0) I ('HLEID) D ERRBULL^SCDXMSG2("Unable to initialize HL7 variables - protocol not found") Q "RTN","SCDXMSG",48,0) ;Initialze HL7 variables "RTN","SCDXMSG",49,0) D INIT^HLFNC2(HLEID,.HL) "RTN","SCDXMSG",50,0) ;Unable to initialize HL7 variables - send error bulletin - done "RTN","SCDXMSG",51,0) I ($O(HL(""))="") D ERRBULL^SCDXMSG2($P(HL,"^",2)) Q "RTN","SCDXMSG",52,0) ;Create batch message "RTN","SCDXMSG",53,0) D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1) "RTN","SCDXMSG",54,0) ;Unable to create batch message - send error bulletin - done "RTN","SCDXMSG",55,0) I ('HLMTIEN) D ERRBULL^SCDXMSG2("Unable to create batch HL7 message") Q "RTN","SCDXMSG",56,0) ;Initialize message count "RTN","SCDXMSG",57,0) S BATCHCNT=0 "RTN","SCDXMSG",58,0) ;Initialize message number "RTN","SCDXMSG",59,0) S MSGNUM=1 "RTN","SCDXMSG",60,0) ;Initialize line count "RTN","SCDXMSG",61,0) S LINECNT=1 "RTN","SCDXMSG",62,0) N VALER,VALERR "RTN","SCDXMSG",63,0) ;this global contains the validation errors if any. "RTN","SCDXMSG",64,0) S VALER="^TMP(""SCDXVALID"",$J)" "RTN","SCDXMSG",65,0) ;Loop through list of [deleted] encounters requiring transmission "RTN","SCDXMSG",66,0) S SCDXEVNT="" "RTN","SCDXMSG",67,0) F S SCDXEVNT=+$O(^SD(409.73,"AACXMIT",SCDXEVNT)) Q:('SCDXEVNT) D "RTN","SCDXMSG",68,0) .S XMITPTR="" "RTN","SCDXMSG",69,0) .F S XMITPTR=+$O(^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR)) Q:('XMITPTR) D "RTN","SCDXMSG",70,0) ..N OENODE,PARENT,FILERR "RTN","SCDXMSG",71,0) ..S VALERR="^TMP(""SCDXVALID"",$J,"_XMITPTR_")" "RTN","SCDXMSG",72,0) ..;Bad entry in cross reference - delete cross reference and quit "RTN","SCDXMSG",73,0) ..I ('$D(^SD(409.73,XMITPTR))) K ^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR) Q "RTN","SCDXMSG",74,0) ..;Make sure entry points to an existing encounter - delete entry "RTN","SCDXMSG",75,0) ..; and quit if it doesn't "RTN","SCDXMSG",76,0) ..S X=^SD(409.73,XMITPTR,0) "RTN","SCDXMSG",77,0) ..S X1=+$P(X,"^",2) "RTN","SCDXMSG",78,0) ..S X2=+$P(X,"^",3) "RTN","SCDXMSG",79,0) ..S OENODE=$S($G(^SCE(+X1,0)):^(0),1:$G(^SD(409.74,+X2,1))),PARENT=$P(OENODE,"^",6) "RTN","SCDXMSG",80,0) ..I (((X1)&('$D(^SCE(X1))))!((X2)&('$D(^SD(409.74,X2))))) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q "RTN","SCDXMSG",81,0) ..; if SD*5.3*70 cleanup not complete, recheck date of encounter for range "RTN","SCDXMSG",82,0) ..I $G(SDEND) Q:$$CHKD(X1,X2) "RTN","SCDXMSG",83,0) ..;If inpatient appointment, delete entry and quit "RTN","SCDXMSG",84,0) ..;Commented to allow transmission of inpatient to NPCD; SD*5.3*387 "RTN","SCDXMSG",85,0) ..;I ($$INPATENC^SCDXUTL(XMITPTR)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q "RTN","SCDXMSG",86,0) ..;If test patient, delete entry and quit "RTN","SCDXMSG",87,0) ..I $$TESTPAT^VADPT($P($$EZN4XMIT^SCDXFU11(XMITPTR),"^",2)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q "RTN","SCDXMSG",88,0) ..;If child encounter, delete entry, flag parent for xmit, and quit "RTN","SCDXMSG",89,0) ..I PARENT D Q "RTN","SCDXMSG",90,0) ...S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) "RTN","SCDXMSG",91,0) ..;NPCD will not accept for database credit - clean up and quit "RTN","SCDXMSG",92,0) ..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 D Q ;SD*5.3*247 "RTN","SCDXMSG",93,0) ...;Past database close-out date - delete previously reported errors "RTN","SCDXMSG",94,0) ...D DELAERR^SCDXFU02(XMITPTR) "RTN","SCDXMSG",95,0) ...;Turn off transmission flag "RTN","SCDXMSG",96,0) ...D XMITFLAG^SCDXFU01(XMITPTR,1) "RTN","SCDXMSG",97,0) ..;Calculate message control ID "RTN","SCDXMSG",98,0) ..S MSGID=HLMID_"-"_MSGNUM "RTN","SCDXMSG",99,0) ..;Put [deleted] encounter into transmission "RTN","SCDXMSG",100,0) ..S ERROR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,MSGID,HL7XMIT,LINECNT,VALERR) "RTN","SCDXMSG",101,0) ..;[Deleted] encounter not added to transmission "RTN","SCDXMSG",102,0) ..I ERROR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0) "RTN","SCDXMSG",103,0) ..D DELAERR^SCDXFU02(XMITPTR,0) "RTN","SCDXMSG",104,0) ..I $O(@VALERR@(0))]"" S FILERR=$$FILEVERR^SCMSVUT2(XMITPTR,VALERR) "RTN","SCDXMSG",105,0) ..I ERROR<0 Q "RTN","SCDXMSG",106,0) ..;Increment line count "RTN","SCDXMSG",107,0) ..S LINECNT=LINECNT+ERROR "RTN","SCDXMSG",108,0) ..;Increment message count "RTN","SCDXMSG",109,0) ..S BATCHCNT=BATCHCNT+1 "RTN","SCDXMSG",110,0) ..;Increment message number "RTN","SCDXMSG",111,0) ..S MSGNUM=MSGNUM+1 "RTN","SCDXMSG",112,0) ..;Create entry in ACRP Transmission History file (#409.77) "RTN","SCDXMSG",113,0) ..S X=$$CRTHIST^SCDXFU10(XMITPTR,HLDT,MSGID,HLMID) "RTN","SCDXMSG",114,0) ..;Update transmission info for [deleted] encounter "RTN","SCDXMSG",115,0) ..D XMITDATA^SCDXFU03(XMITPTR,HLDT,MSGID,HLMID) "RTN","SCDXMSG",116,0) ..;Turn off transmission flag for [deleted] encounter "RTN","SCDXMSG",117,0) ..D XMITFLAG^SCDXFU01(XMITPTR,1) "RTN","SCDXMSG",118,0) ..;Delete all errors previously reported for [deleted] encounter "RTN","SCDXMSG",119,0) ..D DELAERR^SCDXFU02(XMITPTR) "RTN","SCDXMSG",120,0) ..;Reached max size for batch "RTN","SCDXMSG",121,0) ..I ((MSGNUM>MAXBATCH)!(LINECNT>MAXLINE)) D "RTN","SCDXMSG",122,0) ...;Send batch message - immediate priority "RTN","SCDXMSG",123,0) ...S HLP("PRIORITY")="I" "RTN","SCDXMSG",124,0) ...D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP) "RTN","SCDXMSG",125,0) ...;Re-initialize HL7 message "RTN","SCDXMSG",126,0) ...K @HL7XMIT "RTN","SCDXMSG",127,0) ...;Re-initialize HL7 variables "RTN","SCDXMSG",128,0) ...K HL,HLRESLT,HLP,HLMID,HLMTIEN,HLDT,HLDT1 "RTN","SCDXMSG",129,0) ...S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0)) "RTN","SCDXMSG",130,0) ...D INIT^HLFNC2(HLEID,.HL) "RTN","SCDXMSG",131,0) ...;Create new batch message "RTN","SCDXMSG",132,0) ...D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1) "RTN","SCDXMSG",133,0) ...;Re-initialize line count "RTN","SCDXMSG",134,0) ...S LINECNT=1 "RTN","SCDXMSG",135,0) ...;Re-initialize message number "RTN","SCDXMSG",136,0) ...S MSGNUM=1 "RTN","SCDXMSG",137,0) ;Check for unsent batch message "RTN","SCDXMSG",138,0) I ($O(@HL7XMIT@(0))) D "RTN","SCDXMSG",139,0) .;Send batch message - immediate priority "RTN","SCDXMSG",140,0) .S HLP("PRIORITY")="I" "RTN","SCDXMSG",141,0) .D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP) "RTN","SCDXMSG",142,0) N ERRCNT "RTN","SCDXMSG",143,0) S ERRCNT=$$COUNT^SCMSVUT2(VALER) "RTN","SCDXMSG",144,0) ;Send completion bulletin "RTN","SCDXMSG",145,0) D CMPLBULL^SCDXMSG2(BATCHCNT,ERRCNT) "RTN","SCDXMSG",146,0) ;Clean up global arrays used "RTN","SCDXMSG",147,0) K @XMITERR,@HL7XMIT,@VALER "RTN","SCDXMSG",148,0) ;Determine if updating of Hospital Location file hasn't completed AND "RTN","SCDXMSG",149,0) ; if today is past the OPC to HL7 cut over date "RTN","SCDXMSG",150,0) I ('$P($G(^SD(404.91,1,"AMB")),"^",7)) I ($$DATE^SCDXUTL(DT)) D "RTN","SCDXMSG",151,0) .;Task updating of Hospital Location file "RTN","SCDXMSG",152,0) .N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK "RTN","SCDXMSG",153,0) .S ZTRTN="HOPUP^SCMSP" "RTN","SCDXMSG",154,0) .S ZTDESC="REQUIRE PROVIDER AND DIAGNOSIS FOR CHECKOUT FROM CLINICS" "RTN","SCDXMSG",155,0) .S ZTDTH="NOW" "RTN","SCDXMSG",156,0) .S ZTIO="" "RTN","SCDXMSG",157,0) .D ^%ZTLOAD "RTN","SCDXMSG",158,0) ;Done "RTN","SCDXMSG",159,0) Q "RTN","SCDXMSG",160,0) ; "RTN","SCDXMSG",161,0) CHKD(X1,X2) ; if clean-up still in progress for SD*5.3*70, check date "RTN","SCDXMSG",162,0) N SDELE "RTN","SCDXMSG",163,0) I X1,+$G(^SCE(X1,0))>SDEND Q 1 "RTN","SCDXMSG",164,0) I X2 S SDELE=+$G(^SD(409.74,X2,1)) I SDELE>SDSTA D:SDELE0) ERROR=0 "RTN","SCDXMSG1",69,0) Q "RTN","SCDXMSG1",70,0) VLDPID S ERROR=$$EN^SCMSVPID(.VAFPID,HL("Q"),HL("FS"),HL("ECH"),VALERR,ENCDT,EVNTHL7) "RTN","SCDXMSG1",71,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",72,0) Q "RTN","SCDXMSG1",73,0) VLDZPD S ERROR=$$EN^SCMSVZPD(VAFZPD,HL("Q"),HL("FS"),VALERR,ENCDT,NODE) "RTN","SCDXMSG1",74,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",75,0) Q "RTN","SCDXMSG1",76,0) VLDPV1 S ERROR=$$EN^SCMSVPV1(VAFPV1,HL("Q"),HL("FS"),VALERR,NODE,EVNTHL7,ENCNDT) "RTN","SCDXMSG1",77,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",78,0) Q "RTN","SCDXMSG1",79,0) VLDDG1 S ERROR=$$EN^SCMSVDG1(VAFARRY,HL("Q"),HL("FS"),ENCPTR,VALERR,ENCDT) "RTN","SCDXMSG1",80,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",81,0) Q "RTN","SCDXMSG1",82,0) VLDPR1 S ERROR=$$EN^SCMSVPR1(VAFARRY,HL("Q"),HL("FS"),HL("ECH"),VALERR,ENCDT) "RTN","SCDXMSG1",83,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",84,0) Q "RTN","SCDXMSG1",85,0) VLDZEL S ERROR=$$EN^SCMSVZEL(.VAFZEL,HL("Q"),HL("FS"),VALERR,DFN) "RTN","SCDXMSG1",86,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",87,0) Q "RTN","SCDXMSG1",88,0) VLDZIR S ERROR=$$EN^SCMSVZIR(VAFZIR,HL("Q"),HL("FS"),VALERR) "RTN","SCDXMSG1",89,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",90,0) Q "RTN","SCDXMSG1",91,0) VLDZCL S ERROR=$$EN^SCMSVZCL(VAFARRY,HL("Q"),HL("FS"),VALERR,DFN) "RTN","SCDXMSG1",92,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",93,0) Q "RTN","SCDXMSG1",94,0) VLDZSC S ERROR=$$EN^SCMSVZSC(VAFARRY,HL("Q"),HL("FS"),VALERR,ENCPTR) "RTN","SCDXMSG1",95,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",96,0) Q "RTN","SCDXMSG1",97,0) VLDZSP S ERROR=$$EN^SCMSVZSP(VAFZSP,HL("Q"),HL("FS"),VALERR,DFN) "RTN","SCDXMSG1",98,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",99,0) Q "RTN","SCDXMSG1",100,0) VLDROL S ERROR=$$EN^SCMSVROL(VAFARRY,HL("Q"),HL("FS"),HL("ECH"),VALERR) "RTN","SCDXMSG1",101,0) S:(ERROR>0) ERROR=0 "RTN","SCDXMSG1",102,0) Q "RTN","SCDXMSG1",103,0) VLDPD1 S ERROR=0 "RTN","SCDXMSG1",104,0) Q "RTN","SCDXMSG1",105,0) VLDZEN S ERROR=0 "RTN","SCDXMSG1",106,0) Q "RTN","SCDXMSG1",107,0) ; "RTN","SCDXMSG1",108,0) ;-- Line tags for copying HL7 segments into HL7 message "RTN","SCDXMSG1",109,0) CPYEVN N I "RTN","SCDXMSG1",110,0) S @XMITARRY@(CURLINE)=VAFEVN "RTN","SCDXMSG1",111,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",112,0) S I="" "RTN","SCDXMSG1",113,0) F S I=+$O(VAFEVN(I)) Q:('I) D "RTN","SCDXMSG1",114,0) .S @XMITARRY@(CURLINE,I)=VAFEVN(I) "RTN","SCDXMSG1",115,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",116,0) Q "RTN","SCDXMSG1",117,0) CPYPID N I "RTN","SCDXMSG1",118,0) S @XMITARRY@(CURLINE)=VAFPID "RTN","SCDXMSG1",119,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",120,0) S I="" "RTN","SCDXMSG1",121,0) F S I=+$O(VAFPID(I)) Q:('I) D "RTN","SCDXMSG1",122,0) .S @XMITARRY@(CURLINE,I)=VAFPID(I) "RTN","SCDXMSG1",123,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",124,0) Q "RTN","SCDXMSG1",125,0) CPYZPD N I "RTN","SCDXMSG1",126,0) S @XMITARRY@(CURLINE)=VAFZPD "RTN","SCDXMSG1",127,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",128,0) S I="" "RTN","SCDXMSG1",129,0) F S I=+$O(VAFZPD(I)) Q:('I) D "RTN","SCDXMSG1",130,0) .S @XMITARRY@(CURLINE,I)=VAFZPD(I) "RTN","SCDXMSG1",131,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",132,0) Q "RTN","SCDXMSG1",133,0) CPYPV1 N I "RTN","SCDXMSG1",134,0) S @XMITARRY@(CURLINE)=VAFPV1 "RTN","SCDXMSG1",135,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",136,0) S I="" "RTN","SCDXMSG1",137,0) F S I=+$O(VAFPV1(I)) Q:('I) D "RTN","SCDXMSG1",138,0) .S @XMITARRY@(CURLINE,I)=VAFPV1(I) "RTN","SCDXMSG1",139,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",140,0) Q "RTN","SCDXMSG1",141,0) CPYDG1 N I,J,K "RTN","SCDXMSG1",142,0) S I="" "RTN","SCDXMSG1",143,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",144,0) .S J="" "RTN","SCDXMSG1",145,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",146,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",147,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",148,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",149,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",150,0) Q "RTN","SCDXMSG1",151,0) CPYPR1 N I,J,K "RTN","SCDXMSG1",152,0) S I="" "RTN","SCDXMSG1",153,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",154,0) .S J="" "RTN","SCDXMSG1",155,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",156,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",157,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",158,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",159,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",160,0) Q "RTN","SCDXMSG1",161,0) CPYZEL N I "RTN","SCDXMSG1",162,0) S @XMITARRY@(CURLINE)=VAFZEL(1) "RTN","SCDXMSG1",163,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",164,0) S I="" "RTN","SCDXMSG1",165,0) F S I=+$O(VAFZEL(1,I)) Q:('I) D "RTN","SCDXMSG1",166,0) .S @XMITARRY@(CURLINE,I)=VAFZEL(1,I) "RTN","SCDXMSG1",167,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",168,0) Q "RTN","SCDXMSG1",169,0) CPYZIR N I "RTN","SCDXMSG1",170,0) S @XMITARRY@(CURLINE)=VAFZIR "RTN","SCDXMSG1",171,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",172,0) N I "RTN","SCDXMSG1",173,0) S I="" "RTN","SCDXMSG1",174,0) F S I=+$O(VAFZIR(I)) Q:('I) D "RTN","SCDXMSG1",175,0) .S @XMITARRY@(CURLINE,I)=VAFZIR(I) "RTN","SCDXMSG1",176,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",177,0) Q "RTN","SCDXMSG1",178,0) CPYZCL N I,J,K "RTN","SCDXMSG1",179,0) S I="" "RTN","SCDXMSG1",180,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",181,0) .S J="" "RTN","SCDXMSG1",182,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",183,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",184,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",185,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",186,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",187,0) Q "RTN","SCDXMSG1",188,0) CPYZSC N I,J,K "RTN","SCDXMSG1",189,0) S I="" "RTN","SCDXMSG1",190,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",191,0) .S J="" "RTN","SCDXMSG1",192,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",193,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",194,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",195,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",196,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",197,0) Q "RTN","SCDXMSG1",198,0) CPYZSP N I "RTN","SCDXMSG1",199,0) S @XMITARRY@(CURLINE)=VAFZSP "RTN","SCDXMSG1",200,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",201,0) S I="" "RTN","SCDXMSG1",202,0) F S I=+$O(VAFZSP(I)) Q:('I) D "RTN","SCDXMSG1",203,0) .S @XMITARRY@(CURLINE,I)=VAFZSP(I) "RTN","SCDXMSG1",204,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",205,0) Q "RTN","SCDXMSG1",206,0) CPYROL N I,J,K "RTN","SCDXMSG1",207,0) S I="" "RTN","SCDXMSG1",208,0) F K=0:1 S I=+$O(@VAFARRY@(I)) Q:('I) D "RTN","SCDXMSG1",209,0) .S J="" "RTN","SCDXMSG1",210,0) .F S J=$O(@VAFARRY@(I,J)) Q:(J="") D "RTN","SCDXMSG1",211,0) ..S:('J) @XMITARRY@(CURLINE+K)=@VAFARRY@(I,J) "RTN","SCDXMSG1",212,0) ..S:(J) @XMITARRY@(CURLINE+K,J)=@VAFARRY@(I,J) "RTN","SCDXMSG1",213,0) ..S LINESADD=LINESADD+1 "RTN","SCDXMSG1",214,0) S CURLINE=CURLINE+K-1 "RTN","SCDXMSG1",215,0) Q "RTN","SCDXMSG1",216,0) CPYPD1 N I "RTN","SCDXMSG1",217,0) S @XMITARRY@(CURLINE)=VAFPD1 "RTN","SCDXMSG1",218,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",219,0) S I="" "RTN","SCDXMSG1",220,0) F S I=+$O(VAFPD1(I)) Q:('I) D "RTN","SCDXMSG1",221,0) .S @XMITARRY@(CURLINE,I)=VAFPD1(I) "RTN","SCDXMSG1",222,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",223,0) Q "RTN","SCDXMSG1",224,0) CPYZEN N I "RTN","SCDXMSG1",225,0) S @XMITARRY@(CURLINE)=VAFZEN "RTN","SCDXMSG1",226,0) S LINESADD=LINESADD+1 "RTN","SCDXMSG1",227,0) S I="" "RTN","SCDXMSG1",228,0) F S I=+$O(VAFZEN(I)) Q:('I) D "RTN","SCDXMSG1",229,0) .S @XMITARRY@(CURLINE,I)=VAFZEN(I) "RTN","SCDXMSG1",230,0) .S LINESADD=LINESADD+1 "RTN","SCDXMSG1",231,0) Q "RTN","SCDXMSG1",232,0) ; "RTN","SCDXMSG1",233,0) ;-- Line tags for deleting HL7 segments "RTN","SCDXMSG1",234,0) DELEVN K VAFEVN "RTN","SCDXMSG1",235,0) Q "RTN","SCDXMSG1",236,0) DELPID K VAFPID "RTN","SCDXMSG1",237,0) Q "RTN","SCDXMSG1",238,0) DELZPD K VAFZPD "RTN","SCDXMSG1",239,0) Q "RTN","SCDXMSG1",240,0) DELPV1 K VAFPV1 "RTN","SCDXMSG1",241,0) Q "RTN","SCDXMSG1",242,0) DELDG1 K @VAFARRY "RTN","SCDXMSG1",243,0) Q "RTN","SCDXMSG1",244,0) DELPR1 K @VAFARRY "RTN","SCDXMSG1",245,0) Q "RTN","SCDXMSG1",246,0) DELZEL K VAFZEL "RTN","SCDXMSG1",247,0) Q "RTN","SCDXMSG1",248,0) DELZIR K VAFZIR "RTN","SCDXMSG1",249,0) Q "RTN","SCDXMSG1",250,0) DELZCL K @VAFARRY "RTN","SCDXMSG1",251,0) Q "RTN","SCDXMSG1",252,0) DELZSC K @VAFARRY "RTN","SCDXMSG1",253,0) Q "RTN","SCDXMSG1",254,0) DELZSP K VAFZSP "RTN","SCDXMSG1",255,0) Q "RTN","SCDXMSG1",256,0) DELROL K @VAFARRY "RTN","SCDXMSG1",257,0) Q "RTN","SCDXMSG1",258,0) DELPD1 K VAFPD1 "RTN","SCDXMSG1",259,0) Q "RTN","SCDXMSG1",260,0) DELZEN K VAFZEN "RTN","SCDXMSG1",261,0) Q "RTN","SCDXMSG1",262,0) ; "RTN","SCDXMSG1",263,0) ; "RTN","SCDXMSG1",264,0) SEGMENTS(EVNTTYPE,SEGARRY) ;Build list of HL7 segments for a given "RTN","SCDXMSG1",265,0) ; event type "RTN","SCDXMSG1",266,0) ; "RTN","SCDXMSG1",267,0) ;Input : EVNTTYPE - Event type to build list for "RTN","SCDXMSG1",268,0) ; A08 & A23 are the only types currently supported "RTN","SCDXMSG1",269,0) ; (Defaults to A08) "RTN","SCDXMSG1",270,0) ; SEGARRY - Array to place output in (full global reference) "RTN","SCDXMSG1",271,0) ; (Defaults to ^TMP("SCDX SEGMENTS",$J)) "RTN","SCDXMSG1",272,0) ;Output : None "RTN","SCDXMSG1",273,0) ; SEGARRY(Seq,Name) = Fields "RTN","SCDXMSG1",274,0) ; Seq - Sequencing number to order the segments as "RTN","SCDXMSG1",275,0) ; they should be placed in the HL7 message "RTN","SCDXMSG1",276,0) ; Name - Name of HL7 segment "RTN","SCDXMSG1",277,0) ; Fields - List of fields used by Ambulatory Care "RTN","SCDXMSG1",278,0) ; VAFSTR would be set to this value "RTN","SCDXMSG1",279,0) ; : MSH segment is not included "RTN","SCDXMSG1",280,0) ; "RTN","SCDXMSG1",281,0) ;Check input "RTN","SCDXMSG1",282,0) S EVNTTYPE=$G(EVNTTYPE) "RTN","SCDXMSG1",283,0) S:(EVNTTYPE'="A23") EVNTTYPE="A08" "RTN","SCDXMSG1",284,0) S SEGARRY=$G(SEGARRY) "RTN","SCDXMSG1",285,0) S:(SEGARRY="") SEGARRY="^TMP(""SCDX SEGMENTS"","_$J_")" "RTN","SCDXMSG1",286,0) ;Segments used by A08 & A23 "RTN","SCDXMSG1",287,0) S @SEGARRY@(1,"EVN")="1,2" "RTN","SCDXMSG1",288,0) S @SEGARRY@(2,"PID")="1,2,3,4,5,6,7,8,10N,11PC,13,14,16,17,19,22N" "RTN","SCDXMSG1",289,0) S @SEGARRY@(3,"PD1")="3,4" "RTN","SCDXMSG1",290,0) S @SEGARRY@(4,"PV1")="1,2,4,14,19,39,44,50" "RTN","SCDXMSG1",291,0) ;Building list for A23 - add ZPD segment and quit "RTN","SCDXMSG1",292,0) I (EVNTTYPE="A23") D Q "RTN","SCDXMSG1",293,0) .S @SEGARRY@(5,"ZPD")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21" "RTN","SCDXMSG1",294,0) S @SEGARRY@(5,"DG1")="1,2,3,4,5,15" "RTN","SCDXMSG1",295,0) S @SEGARRY@(6,"PR1")="1,3,16" "RTN","SCDXMSG1",296,0) S @SEGARRY@(7,"ROL")="1,2,3,4" "RTN","SCDXMSG1",297,0) S @SEGARRY@(8,"ZPD")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21" "RTN","SCDXMSG1",298,0) S @SEGARRY@(9,"ZEL")="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,29,37,38" "RTN","SCDXMSG1",299,0) S @SEGARRY@(10,"ZIR")="1,2,3,4,5,6,7,8,9,10,11,12,13" "RTN","SCDXMSG1",300,0) S @SEGARRY@(11,"ZCL")="1,2,3" "RTN","SCDXMSG1",301,0) S @SEGARRY@(12,"ZSC")="1,2,3" "RTN","SCDXMSG1",302,0) S @SEGARRY@(13,"ZSP")="1,2,3,4" "RTN","SCDXMSG1",303,0) S @SEGARRY@(14,"ZEN")="1,2,3,4,5,6,7,8,9,10" "RTN","SCDXMSG1",304,0) Q "RTN","SCDXMSG1",305,0) ; "RTN","SCDXMSG1",306,0) UNWIND(XMITARRY,INSRTPNT) ;Remove all data that was put into HL7 message "RTN","SCDXMSG1",307,0) ; "RTN","SCDXMSG1",308,0) ;Input : XMITARRY - Array containing HL7 message (full global ref) "RTN","SCDXMSG1",309,0) ; (Defaults to ^TMP("HLS",$J)) "RTN","SCDXMSG1",310,0) ; INSRTPNT - Where to begin deletion from (Defaults to 1) "RTN","SCDXMSG1",311,0) ;Output : None "RTN","SCDXMSG1",312,0) ; "RTN","SCDXMSG1",313,0) ;Check input "RTN","SCDXMSG1",314,0) S XMITARRY=$G(XMITARRY) "RTN","SCDXMSG1",315,0) S:(XMITARRY="") XMITARRY="^TMP(""HLS"","_$J_")" "RTN","SCDXMSG1",316,0) S INSRTPNT=$G(INSRTPNT) "RTN","SCDXMSG1",317,0) S:(INSRTPNT="") INSRTPNT=1 "RTN","SCDXMSG1",318,0) ;Remove insertion point from array "RTN","SCDXMSG1",319,0) K @XMITARRY@(INSRTPNT) "RTN","SCDXMSG1",320,0) ;Remove everything from insertion point to end of array "RTN","SCDXMSG1",321,0) F S INSRTPNT=$O(@XMITARRY@(INSRTPNT)) Q:(INSRTPNT="") K @XMITARRY@(INSRTPNT) "RTN","SCDXMSG1",322,0) ;Done "RTN","SCDXMSG1",323,0) Q "RTN","SCMSVPV1") 0^3^B6609913 "RTN","SCMSVPV1",1,0) SCMSVPV1 ;ALB/ESD HL7 PV1 Segment Validation ; 23 Oct 98 3:45 PM "RTN","SCMSVPV1",2,0) ;;5.3;Scheduling;**44,55,91,66,162,387**;Aug 13, 1993 "RTN","SCMSVPV1",3,0) ; "RTN","SCMSVPV1",4,0) ; "RTN","SCMSVPV1",5,0) EN(PV1SEG,HLQ,HLFS,VALERR,NODE,EVNTHL7,ENCNDT) ; "RTN","SCMSVPV1",6,0) ; Entry point to return the HL7 PV1 (Patient Visit) validation segment "RTN","SCMSVPV1",7,0) ; "RTN","SCMSVPV1",8,0) ; Input: PV1SEG - PV1 Segment "RTN","SCMSVPV1",9,0) ; HLQ - HL7 null variable "RTN","SCMSVPV1",10,0) ; HLFS - HL7 field separator "RTN","SCMSVPV1",11,0) ; VALERR - The array to put errors in "RTN","SCMSVPV1",12,0) ; EVNTHL7 - Event type ("A08" for add/edit, "A23" for delete) "RTN","SCMSVPV1",13,0) ; ENCNDT - Encounter date "RTN","SCMSVPV1",14,0) ; "RTN","SCMSVPV1",15,0) ; Output: 1 if PV1 passed validity check "RTN","SCMSVPV1",16,0) ; Error message if PV1 failed validity check in form of: "RTN","SCMSVPV1",17,0) ; -1^"xxx failed validity check" (xxx=element in PV1 segment) "RTN","SCMSVPV1",18,0) ; "RTN","SCMSVPV1",19,0) ;NOTE: "RTN","SCMSVPV1",20,0) ;this routine uses the variable NODE which would contain the zero node "RTN","SCMSVPV1",21,0) ;of the encounter. It is looking for the division in the 11th piece. "RTN","SCMSVPV1",22,0) ;this is for the check on the facility. "RTN","SCMSVPV1",23,0) ; "RTN","SCMSVPV1",24,0) N I,MSG,X,CNT,DATA,SEG,SD,XMTFLG "RTN","SCMSVPV1",25,0) ; "RTN","SCMSVPV1",26,0) ;-Create array of elements to validate "RTN","SCMSVPV1",27,0) F I=1,3,5,510,15,40,401,45,51 S SD(I)="" ;Elements for 'add' or 'edit' transactions "RTN","SCMSVPV1",28,0) I $G(EVNTHL7)="A23" K SD F I=40,45,51 S SD(I)="" ;Elements for 'delete' transactions "RTN","SCMSVPV1",29,0) ; "RTN","SCMSVPV1",30,0) S MSG="-1^Element in PV1 segment failed validity check",CNT=1 "RTN","SCMSVPV1",31,0) S PV1SEG=$G(PV1SEG),SEG="PV1" "RTN","SCMSVPV1",32,0) D VALIDATE^SCMSVUT0(SEG,PV1SEG,"0008",VALERR,.CNT) "RTN","SCMSVPV1",33,0) I $D(@VALERR@(SEG)) G ENQ "RTN","SCMSVPV1",34,0) ; "RTN","SCMSVPV1",35,0) ;- Convert HLQ to null "RTN","SCMSVPV1",36,0) S PV1SEG=$$CONVERT^SCMSVUT0(PV1SEG,HLFS,HLQ) "RTN","SCMSVPV1",37,0) ; "RTN","SCMSVPV1",38,0) ;- Validate data elements "RTN","SCMSVPV1",39,0) F I=1,3,5,510,15,40,401,45,51 D "RTN","SCMSVPV1",40,0) . S DATA=$S(I=45:$$FMDATE^HLFNC($P(PV1SEG,HLFS,+I)),I=510:$P(PV1SEG,HLFS,+$E(I,1,1)),I=401:$P(PV1SEG,HLFS,+$E(I,1,2)),1:$P(PV1SEG,HLFS,+I)) "RTN","SCMSVPV1",41,0) . I I=40!(I=401) N DIV S DIV=$S($D(NODE):$P(NODE,U,11),1:"") "RTN","SCMSVPV1",42,0) . I I=45 S XMTFLG=$S($P(PV1SEG,HLFS,3)="I":1,1:0) "RTN","SCMSVPV1",43,0) . D:$D(SD(I)) VALIDATE^SCMSVUT0(SEG,DATA,$P($T(@(I)),";",3),VALERR,.CNT) "RTN","SCMSVPV1",44,0) . Q "RTN","SCMSVPV1",45,0) ;if inpatient perform validation for NPCD closeout on encounter date "RTN","SCMSVPV1",46,0) I $P(PV1SEG,HLFS,3)="I" D "RTN","SCMSVPV1",47,0) .S XMTFLG=0 "RTN","SCMSVPV1",48,0) .D VALIDATE^SCMSVUT0(SEG,ENCNDT,"4200",VALERR,.CNT) "RTN","SCMSVPV1",49,0) ; "RTN","SCMSVPV1",50,0) ENQ Q $S($D(@VALERR@(SEG)):MSG,1:1) "RTN","SCMSVPV1",51,0) ; "RTN","SCMSVPV1",52,0) ; "RTN","SCMSVPV1",53,0) ; "RTN","SCMSVPV1",54,0) ERR ;;Invalid or missing patient visit data for encounter (HL7 PV1 segment) "RTN","SCMSVPV1",55,0) ; "RTN","SCMSVPV1",56,0) ; "RTN","SCMSVPV1",57,0) ;- PV1 data elements validated "RTN","SCMSVPV1",58,0) ; "RTN","SCMSVPV1",59,0) 1 ;;0035;HL7 SEGMENT NAME "RTN","SCMSVPV1",60,0) 3 ;;4000;PATIENT CLASS "RTN","SCMSVPV1",61,0) 5 ;;4050;PURPOSE OF VISIT/APPT TYPE "RTN","SCMSVPV1",62,0) 510 ;;Z000;Invalid Appointment Type (Computer Generated) "RTN","SCMSVPV1",63,0) 15 ;;4070;LOCATION OF VISIT "RTN","SCMSVPV1",64,0) 40 ;;4150;FACILITY NUMBER/SUFFIX "RTN","SCMSVPV1",65,0) 401 ;;4160;INACTIVE FACILITY "RTN","SCMSVPV1",66,0) 45 ;;4200;VISIT (ENCOUNTER) DATE/TIME "RTN","SCMSVPV1",67,0) 51 ;;4100;UNIQUE IDENTIFIER (PCE) "RTN","SCMSVUT1") 0^2^B65985223 "RTN","SCMSVUT1",1,0) SCMSVUT1 ;ALB/JLU;validation utility routine;06/19/99 ; 4/30/03 11:58am "RTN","SCMSVUT1",2,0) ;;5.3;Scheduling;**66,143,180,239,247,258,296,295,321,341,387**;AUG 13,1993 "RTN","SCMSVUT1",3,0) ;06/19/99 ACS - Added CPT Modifier API calls to PROCCOD(DATA) "RTN","SCMSVUT1",4,0) ; "RTN","SCMSVUT1",5,0) SEGERR(DATA,HLFS) ; "RTN","SCMSVUT1",6,0) ;INPUT DATA - This is a check for the segment errors of null "RTN","SCMSVUT1",7,0) ; HLFS - The string separator character "RTN","SCMSVUT1",8,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",9,0) I DATA="" Q 0 "RTN","SCMSVUT1",10,0) I $L(DATA,HLFS)'>2 Q 0 "RTN","SCMSVUT1",11,0) Q 1 "RTN","SCMSVUT1",12,0) ; "RTN","SCMSVUT1",13,0) DODA(DATA) ; "RTN","SCMSVUT1",14,0) ;INPUT DATA - The FM date of death. "RTN","SCMSVUT1",15,0) ; "RTN","SCMSVUT1",16,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",17,0) I DATA="" Q 1 "RTN","SCMSVUT1",18,0) N %DT,X,Y "RTN","SCMSVUT1",19,0) S %DT="T",%DT(0)="-NOW",X=DATA "RTN","SCMSVUT1",20,0) D ^%DT "RTN","SCMSVUT1",21,0) Q $S(Y=-1:0,1:1) "RTN","SCMSVUT1",22,0) ; "RTN","SCMSVUT1",23,0) DODB(DATA,ENCDT) ; "RTN","SCMSVUT1",24,0) ;INPUT DATA - The FM date of death "RTN","SCMSVUT1",25,0) ; ENCDT - The FM date of encounter "RTN","SCMSVUT1",26,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",27,0) I DATA="" Q 1 "RTN","SCMSVUT1",28,0) N %DT,X,Y "RTN","SCMSVUT1",29,0) S %DT="T",%DT(0)=ENCDT,X=DATA "RTN","SCMSVUT1",30,0) D ^%DT "RTN","SCMSVUT1",31,0) Q $S(Y=-1:0,1:1) "RTN","SCMSVUT1",32,0) ; "RTN","SCMSVUT1",33,0) DODL(DATA,ENCDT) ; "RTN","SCMSVUT1",34,0) ;INPUT DATA - The FM date of death "RTN","SCMSVUT1",35,0) ; ENCDT - The FM date of the encounter "RTN","SCMSVUT1",36,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",37,0) I '$D(ENCDT) Q 0 "RTN","SCMSVUT1",38,0) I DATA="" Q 1 "RTN","SCMSVUT1",39,0) I ENCDT14 Q 0 "RTN","SCMSVUT1",45,0) Q 1 "RTN","SCMSVUT1",46,0) ; "RTN","SCMSVUT1",47,0) HOME(DATA) ; "RTN","SCMSVUT1",48,0) ;INPUT DATA - THe homeless indicator to be validated. "RTN","SCMSVUT1",49,0) ; "RTN","SCMSVUT1",50,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",51,0) I DATA'=1,DATA'=0 Q 0 "RTN","SCMSVUT1",52,0) Q 1 "RTN","SCMSVUT1",53,0) ; "RTN","SCMSVUT1",54,0) POW(DATA) ; "RTN","SCMSVUT1",55,0) ;INPUT DATA - The POW indicatort to be validated. "RTN","SCMSVUT1",56,0) ; "RTN","SCMSVUT1",57,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",58,0) I DATA="" Q 1 "RTN","SCMSVUT1",59,0) I DATA'="N",DATA'="U",DATA'="Y" Q 0 "RTN","SCMSVUT1",60,0) Q 1 "RTN","SCMSVUT1",61,0) ; "RTN","SCMSVUT1",62,0) TYPINS(DATA) ; "RTN","SCMSVUT1",63,0) ;INPUT DATA - Type if insurance indicator to be validated. "RTN","SCMSVUT1",64,0) ; "RTN","SCMSVUT1",65,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",66,0) I DATA="" Q 1 "RTN","SCMSVUT1",67,0) I DATA?.A Q 0 "RTN","SCMSVUT1",68,0) I DATA>-1,(DATA<13) Q 1 "RTN","SCMSVUT1",69,0) Q 0 "RTN","SCMSVUT1",70,0) ; "RTN","SCMSVUT1",71,0) PATCLSS(DATA) ; "RTN","SCMSVUT1",72,0) ;INPUT DATA - the patient's class "RTN","SCMSVUT1",73,0) ; "RTN","SCMSVUT1",74,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",75,0) I ("^O^I^")'[("^"_DATA_"^") Q 0 "RTN","SCMSVUT1",76,0) Q 1 "RTN","SCMSVUT1",77,0) ; "RTN","SCMSVUT1",78,0) POV(DATA) ; "RTN","SCMSVUT1",79,0) ;INPUT DATA - the purpose of visit. "RTN","SCMSVUT1",80,0) ; "RTN","SCMSVUT1",81,0) N VAR "RTN","SCMSVUT1",82,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",83,0) I $L(DATA)'=4 Q 0 "RTN","SCMSVUT1",84,0) I DATA?.A Q 0 "RTN","SCMSVUT1",85,0) S VAR=$E(DATA,1,2) "RTN","SCMSVUT1",86,0) I VAR<1!(VAR>4) Q 0 "RTN","SCMSVUT1",87,0) S VAR=$E(DATA,3,4) "RTN","SCMSVUT1",88,0) I VAR<1!(VAR>9) Q 0 "RTN","SCMSVUT1",89,0) Q 1 "RTN","SCMSVUT1",90,0) ; "RTN","SCMSVUT1",91,0) COMPGEN(DATA) ; "RTN","SCMSVUT1",92,0) ;INPUT DATA - checking computer generated. "RTN","SCMSVUT1",93,0) ; "RTN","SCMSVUT1",94,0) N VAR "RTN","SCMSVUT1",95,0) S VAR=$E(DATA,3,4) "RTN","SCMSVUT1",96,0) I VAR=10 Q 0 "RTN","SCMSVUT1",97,0) Q 1 "RTN","SCMSVUT1",98,0) ; "RTN","SCMSVUT1",99,0) LOCVIS(DATA) ; "RTN","SCMSVUT1",100,0) ;INPUT DATA - Location of visit "RTN","SCMSVUT1",101,0) ; "RTN","SCMSVUT1",102,0) I DATA'=1,DATA'=6 Q 0 "RTN","SCMSVUT1",103,0) Q 1 "RTN","SCMSVUT1",104,0) ; "RTN","SCMSVUT1",105,0) FACNMBR(DATA) ; "RTN","SCMSVUT1",106,0) ;INPUT DATA - The facility number "RTN","SCMSVUT1",107,0) ; "RTN","SCMSVUT1",108,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",109,0) I DATA'?3N.AN Q 0 "RTN","SCMSVUT1",110,0) I '$D(^DIC(4,"D",DATA)) Q 0 "RTN","SCMSVUT1",111,0) Q 1 "RTN","SCMSVUT1",112,0) ; "RTN","SCMSVUT1",113,0) FACACT(DATA,ENCDT,DIV) ; "RTN","SCMSVUT1",114,0) ;INPUT DATA - The active flag of the facility number. "RTN","SCMSVUT1",115,0) ; "RTN","SCMSVUT1",116,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",117,0) I '$D(ENCDT) Q 0 "RTN","SCMSVUT1",118,0) I '$D(DIV) Q 0 "RTN","SCMSVUT1",119,0) I DATA="" Q 0 "RTN","SCMSVUT1",120,0) N SITE "RTN","SCMSVUT1",121,0) I DIV]"" S SITE=$$SITE^VASITE(ENCDT,DIV) "RTN","SCMSVUT1",122,0) I DIV']"" S SITE=$$SITE^VASITE(ENCDT) "RTN","SCMSVUT1",123,0) I DATA'=$P(SITE,U,3) Q 0 "RTN","SCMSVUT1",124,0) Q 1 "RTN","SCMSVUT1",125,0) ; "RTN","SCMSVUT1",126,0) ENCDT(DATA,XMTFLG) ; "RTN","SCMSVUT1",127,0) ;INPUT DATA - The date/time of the encounter "RTN","SCMSVUT1",128,0) ; XMTFLG - Flag to check $$OKTOXMIT^SCDXFU04(DATA) "RTN","SCMSVUT1",129,0) ; "RTN","SCMSVUT1",130,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",131,0) S XMTFLG=$G(XMTFLG,0) "RTN","SCMSVUT1",132,0) N %DT,X,Y "RTN","SCMSVUT1",133,0) S %DT="T" "RTN","SCMSVUT1",134,0) S X=DATA "RTN","SCMSVUT1",135,0) D ^%DT "RTN","SCMSVUT1",136,0) I Y=-1 Q 0 "RTN","SCMSVUT1",137,0) I XMTFLG Q 1 "RTN","SCMSVUT1",138,0) N VAR "RTN","SCMSVUT1",139,0) S VAR=$$OKTOXMIT^SCDXFU04(DATA) "RTN","SCMSVUT1",140,0) ;I +VAR=1 Q 1 "RTN","SCMSVUT1",141,0) I +VAR<4&(VAR'<0) Q 1 ;SD*5.3*247 "RTN","SCMSVUT1",142,0) Q 0 "RTN","SCMSVUT1",143,0) ; "RTN","SCMSVUT1",144,0) UNIQNMBR(DATA) ; "RTN","SCMSVUT1",145,0) ;INPUT DATA - The unique number from PCE for the encounter "RTN","SCMSVUT1",146,0) ; "RTN","SCMSVUT1",147,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",148,0) I DATA="" Q 0 "RTN","SCMSVUT1",149,0) I DATA=-1 Q 0 "RTN","SCMSVUT1",150,0) I DATA=0 Q 0 "RTN","SCMSVUT1",151,0) Q 1 "RTN","SCMSVUT1",152,0) ; "RTN","SCMSVUT1",153,0) SEGCHK(DATA,HLFS) ; "RTN","SCMSVUT1",154,0) ;INPUT DATA - The segment to be checked. "RTN","SCMSVUT1",155,0) ; HLFS - The HL7 field separator "RTN","SCMSVUT1",156,0) ; "RTN","SCMSVUT1",157,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",158,0) I DATA="" Q 0 "RTN","SCMSVUT1",159,0) I $L(DATA,HLFS)'>2 Q 0 "RTN","SCMSVUT1",160,0) Q 1 "RTN","SCMSVUT1",161,0) ; "RTN","SCMSVUT1",162,0) SEQNBR(DATA,SEQNBR) ; "RTN","SCMSVUT1",163,0) ;INPUT DATA - The sequence number to be checked. "RTN","SCMSVUT1",164,0) ; SEQNBR - This is the previous seq number to compare to "RTN","SCMSVUT1",165,0) ; "RTN","SCMSVUT1",166,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",167,0) I DATA="" Q 0 "RTN","SCMSVUT1",168,0) I +DATA'=+SEQNBR Q 0 "RTN","SCMSVUT1",169,0) S SEQNBR=SEQNBR+1 "RTN","SCMSVUT1",170,0) Q 1 "RTN","SCMSVUT1",171,0) ; "RTN","SCMSVUT1",172,0) DCODMTHD(DATA) ; "RTN","SCMSVUT1",173,0) ;INPUT DATA - This is the coding method to be checked. "RTN","SCMSVUT1",174,0) ; "RTN","SCMSVUT1",175,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",176,0) I DATA'="I9" Q 0 "RTN","SCMSVUT1",177,0) Q 1 "RTN","SCMSVUT1",178,0) ; "RTN","SCMSVUT1",179,0) DIAGCOD(DATA,ENCDT) ; "RTN","SCMSVUT1",180,0) ;INPUT DATA - This is the diagnosis code "RTN","SCMSVUT1",181,0) ; ENCDT - This is the encounter date "RTN","SCMSVUT1",182,0) ; "RTN","SCMSVUT1",183,0) N VAR "RTN","SCMSVUT1",184,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",185,0) I DATA="" Q 0 "RTN","SCMSVUT1",186,0) ; "RTN","SCMSVUT1",187,0) ; CSV - change to use API "RTN","SCMSVUT1",188,0) ;S VAR=$O(^ICD9("BA",DATA_" ","")) "RTN","SCMSVUT1",189,0) ;I 'VAR Q 0 "RTN","SCMSVUT1",190,0) ;S VAR=$G(^ICD9(VAR,0)) "RTN","SCMSVUT1",191,0) ;I VAR']"" Q 0 "RTN","SCMSVUT1",192,0) ;this is the inactive flag "RTN","SCMSVUT1",193,0) ;I $P(VAR,U,9)'=1 Q 1 "RTN","SCMSVUT1",194,0) ;S VAR=$P(VAR,U,11) "RTN","SCMSVUT1",195,0) ;N %DT,X,Y "RTN","SCMSVUT1",196,0) ;S %DT="ST",%DT(0)=-VAR,X=ENCDT "RTN","SCMSVUT1",197,0) ;D ^%DT "RTN","SCMSVUT1",198,0) ;Q $S(Y=-1:0,1:1) "RTN","SCMSVUT1",199,0) Q $P($$ICDDX^ICDCODE(DATA,ENCDT),"^",10) "RTN","SCMSVUT1",200,0) ; "RTN","SCMSVUT1",201,0) PRIOR(DATA) ; "RTN","SCMSVUT1",202,0) ;INPUT DATA - The priority of the diagnosis found "RTN","SCMSVUT1",203,0) ; "RTN","SCMSVUT1",204,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",205,0) I DATA="" Q 1 "RTN","SCMSVUT1",206,0) I DATA=1 Q 1 "RTN","SCMSVUT1",207,0) Q 0 "RTN","SCMSVUT1",208,0) ; "RTN","SCMSVUT1",209,0) ELIGCODM(DATA) ; "RTN","SCMSVUT1",210,0) ;INPUT DATA - The eligibility code "RTN","SCMSVUT1",211,0) ;A CHECK FOR MISSING "RTN","SCMSVUT1",212,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",213,0) I DATA="" Q 0 "RTN","SCMSVUT1",214,0) I '$D(^DIC(8.1,DATA,0)) Q 0 "RTN","SCMSVUT1",215,0) Q 1 "RTN","SCMSVUT1",216,0) ; "RTN","SCMSVUT1",217,0) ELIGINCV(DATA) ; "RTN","SCMSVUT1",218,0) ;INPUT DATA - Contains the eligibility code in the first piece and "RTN","SCMSVUT1",219,0) ;the veteran status in the second. "RTN","SCMSVUT1",220,0) ; "RTN","SCMSVUT1",221,0) ;the following quit is to stop this edit check. "RTN","SCMSVUT1",222,0) ;Per Austin 9/97 this is not needed. "RTN","SCMSVUT1",223,0) Q 1 "RTN","SCMSVUT1",224,0) N VET,ELIG "RTN","SCMSVUT1",225,0) S VET=$P(DATA,U,2) "RTN","SCMSVUT1",226,0) S ELIG=$P(DATA,U,1) "RTN","SCMSVUT1",227,0) I VET=1&((ELIG<1)!(ELIG>18)) Q 0 "RTN","SCMSVUT1",228,0) I VET=1,ELIG>5,ELIG<15 Q 0 "RTN","SCMSVUT1",229,0) I VET=0,ELIG<6 Q 0 "RTN","SCMSVUT1",230,0) I VET=0,ELIG=11 Q 0 "RTN","SCMSVUT1",231,0) I VET=0,ELIG>14,ELIG'=19 Q 0 "RTN","SCMSVUT1",232,0) Q 1 "RTN","SCMSVUT1",233,0) ; "RTN","SCMSVUT1",234,0) ELIGINCS(DATA) ; "RTN","SCMSVUT1",235,0) ;INPUT DATA - Eligibility code "RTN","SCMSVUT1",236,0) ; "RTN","SCMSVUT1",237,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",238,0) I DATA="" Q 0 "RTN","SCMSVUT1",239,0) I '$D(^DIC(8.1,DATA,0)) Q 0 "RTN","SCMSVUT1",240,0) I +$P(^DIC(8.1,DATA,0),U,7) Q 0 "RTN","SCMSVUT1",241,0) Q 1 "RTN","SCMSVUT1",242,0) ; "RTN","SCMSVUT1",243,0) VETSTAT(DATA) ; "RTN","SCMSVUT1",244,0) ;INPUT DATA - The veteran status indicator "RTN","SCMSVUT1",245,0) ; "RTN","SCMSVUT1",246,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",247,0) I DATA'=0,DATA'=1 Q 0 "RTN","SCMSVUT1",248,0) Q 1 "RTN","SCMSVUT1",249,0) ; "RTN","SCMSVUT1",250,0) VETPOW(DATA,DFN) ; "RTN","SCMSVUT1",251,0) ;INPUT DATA - veteran status to check with POW status. "RTN","SCMSVUT1",252,0) ; DFN - The DFN of the patient. "RTN","SCMSVUT1",253,0) ; "RTN","SCMSVUT1",254,0) N VAR,POW "RTN","SCMSVUT1",255,0) I DATA=0 Q 1 "RTN","SCMSVUT1",256,0) S VAR=$G(^DPT(DFN,.52)) "RTN","SCMSVUT1",257,0) S POW=$S(VAR]"":$P(VAR,U,5),1:VAR) "RTN","SCMSVUT1",258,0) I POW="" Q 1 "RTN","SCMSVUT1",259,0) I POW="Y"!(POW="N")!(POW="U") Q 1 "RTN","SCMSVUT1",260,0) Q 0 "RTN","SCMSVUT1",261,0) ; "RTN","SCMSVUT1",262,0) NMBRDEP(DATA) ; "RTN","SCMSVUT1",263,0) ;INPUT DATA - the number of dependents "RTN","SCMSVUT1",264,0) ; "RTN","SCMSVUT1",265,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",266,0) I DATA="" Q 0 "RTN","SCMSVUT1",267,0) I DATA="XX" Q 1 "RTN","SCMSVUT1",268,0) I DATA'?1.2N Q 0 "RTN","SCMSVUT1",269,0) I +DATA>99!(+DATA<0) Q 0 "RTN","SCMSVUT1",270,0) Q 1 "RTN","SCMSVUT1",271,0) ; "RTN","SCMSVUT1",272,0) PATINC(DATA) ; "RTN","SCMSVUT1",273,0) ;INPUT DATA - The patient's income "RTN","SCMSVUT1",274,0) ; "RTN","SCMSVUT1",275,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",276,0) I DATA="" Q 0 "RTN","SCMSVUT1",277,0) I DATA<0 Q 0 "RTN","SCMSVUT1",278,0) I DATA'?.N.1".".N Q 0 "RTN","SCMSVUT1",279,0) Q 1 "RTN","SCMSVUT1",280,0) ; "RTN","SCMSVUT1",281,0) MEANSTST(DATA) ; "RTN","SCMSVUT1",282,0) ;INPUT DATA - The means test indicator "RTN","SCMSVUT1",283,0) ; "RTN","SCMSVUT1",284,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",285,0) S DATA=","_DATA_"," "RTN","SCMSVUT1",286,0) ; ** SD*296, added 'U' means test indicator to allowed list. "RTN","SCMSVUT1",287,0) I ",AS,AN,N,X,C,G,U,"'[DATA Q 0 "RTN","SCMSVUT1",288,0) Q 1 "RTN","SCMSVUT1",289,0) ; "RTN","SCMSVUT1",290,0) DEPMEANS(DATA) ; "RTN","SCMSVUT1",291,0) ;INPUT DATA - This variable contains the number of dependents in the "RTN","SCMSVUT1",292,0) ; first peice and the means test indicator in the second. "RTN","SCMSVUT1",293,0) ; "RTN","SCMSVUT1",294,0) N MT,DEP "RTN","SCMSVUT1",295,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",296,0) S DEP=$P(DATA,U,1) "RTN","SCMSVUT1",297,0) S MT=","_$P(DATA,U,2)_"," "RTN","SCMSVUT1",298,0) I DEP="XX",(",AS,N,X,U,"'[MT) Q 0 "RTN","SCMSVUT1",299,0) Q 1 "RTN","SCMSVUT1",300,0) ; "RTN","SCMSVUT1",301,0) CLASSQUE(DATA) ; "RTN","SCMSVUT1",302,0) ;INPUT DATA - Classification question value. "RTN","SCMSVUT1",303,0) ; "RTN","SCMSVUT1",304,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",305,0) I DATA'=1,DATA'=0,DATA'="" Q 0 "RTN","SCMSVUT1",306,0) Q 1 "RTN","SCMSVUT1",307,0) ; "RTN","SCMSVUT1",308,0) CLAQUETY(DATA) ; "RTN","SCMSVUT1",309,0) ;INPUT DATA - Outpatient classification type to be checked. "RTN","SCMSVUT1",310,0) ; "RTN","SCMSVUT1",311,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",312,0) I DATA="" Q 0 "RTN","SCMSVUT1",313,0) I '$D(^SD(409.41,DATA,0)) Q 0 "RTN","SCMSVUT1",314,0) Q 1 "RTN","SCMSVUT1",315,0) ; "RTN","SCMSVUT1",316,0) CLAVET(DATA,DFN,TYPE,ENCPTR) ; SD*5.3*341 added parameter ENCPTR "RTN","SCMSVUT1",317,0) ;INPUT DATA - Classification question information to compare to VET "RTN","SCMSVUT1",318,0) ; status "RTN","SCMSVUT1",319,0) ; DFN - The patient to compare this info to. "RTN","SCMSVUT1",320,0) ; TYPE - The classification type. "RTN","SCMSVUT1",321,0) ; ENCPTR - Pointer to Outpatient Encounter "RTN","SCMSVUT1",322,0) ; "RTN","SCMSVUT1",323,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",324,0) I '$D(DFN) Q 0 "RTN","SCMSVUT1",325,0) I '$D(TYPE) Q 0 ; SD*5.3*341 "RTN","SCMSVUT1",326,0) N VET,SDELG0,SDDT ; SD*5.3*341 added 2 new variables "RTN","SCMSVUT1",327,0) S ENCPTR=$G(ENCPTR) ; SD*5.3*341 added this plus next 3 lines "RTN","SCMSVUT1",328,0) S SDDT=+$G(^SCE(ENCPTR,0)) S:'SDDT SDDT=$$DT^XLFDT() "RTN","SCMSVUT1",329,0) S SDELG0=$$EL^SDCO22(DFN,ENCPTR) "RTN","SCMSVUT1",330,0) S VET=$P(SDELG0,U,5) "RTN","SCMSVUT1",331,0) I VET="Y",DATA'=1,DATA'=0,DATA'="" Q 0 "RTN","SCMSVUT1",332,0) ;This edit check is per a mail message from austin "RTN","SCMSVUT1",333,0) I TYPE=4,VET'="Y",DATA'="","^A^B^C^D^"'[("^"_($P($G(^DIC(21,+$P($G(^DPT(DFN,.32)),"^",3),0)),"^",3))_"^") Q 0 "RTN","SCMSVUT1",334,0) I VET'="Y",DATA'="" Q $$SCR^SDCO21(TYPE,DFN,SDDT,ENCPTR) ; SD*5.3*341 "RTN","SCMSVUT1",335,0) Q 1 "RTN","SCMSVUT1",336,0) ; "RTN","SCMSVUT1",337,0) STPCOD(DATA) ; "RTN","SCMSVUT1",338,0) ;INPUT DATA - stop code data to be checked "RTN","SCMSVUT1",339,0) ; "RTN","SCMSVUT1",340,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",341,0) I DATA="" Q 0 "RTN","SCMSVUT1",342,0) I '$D(^DIC(40.7,"C",DATA)) Q 0 "RTN","SCMSVUT1",343,0) Q 1 "RTN","SCMSVUT1",344,0) ; "RTN","SCMSVUT1",345,0) ACTSTP(DATA,ENCDT) ; "RTN","SCMSVUT1",346,0) ;INPUT DATA - IEN of the stop code to be checked. "RTN","SCMSVUT1",347,0) ; ENCDT - the encounter date in question "RTN","SCMSVUT1",348,0) ; "RTN","SCMSVUT1",349,0) N STPCOD,%DT,X,Y "RTN","SCMSVUT1",350,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",351,0) I DATA="" Q 0 "RTN","SCMSVUT1",352,0) S STPCOD=$G(^DIC(40.7,DATA,0)) "RTN","SCMSVUT1",353,0) I STPCOD="" Q 0 "RTN","SCMSVUT1",354,0) I '$P(STPCOD,U,3) Q 1 "RTN","SCMSVUT1",355,0) S %DT(0)="-"_$P(STPCOD,U,3),%DT="T",X=ENCDT "RTN","SCMSVUT1",356,0) D ^%DT "RTN","SCMSVUT1",357,0) Q $S(Y=-1:0,1:1) "RTN","SCMSVUT1",358,0) ; "RTN","SCMSVUT1",359,0) SERCON(DATA) ; "RTN","SCMSVUT1",360,0) ;INPUT DATA - Service connection to be checked, missing or invalid "RTN","SCMSVUT1",361,0) ; "RTN","SCMSVUT1",362,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",363,0) I DATA="" Q 0 "RTN","SCMSVUT1",364,0) I DATA'=1,DATA'=0 Q 0 "RTN","SCMSVUT1",365,0) Q 1 "RTN","SCMSVUT1",366,0) ; "RTN","SCMSVUT1",367,0) SCPER(DATA) ; "RTN","SCMSVUT1",368,0) ;INPUT DATA - Service connected % to be tested "RTN","SCMSVUT1",369,0) ; "RTN","SCMSVUT1",370,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",371,0) I DATA="" Q 1 "RTN","SCMSVUT1",372,0) I DATA'?.N.1".".N Q 0 "RTN","SCMSVUT1",373,0) Q 1 "RTN","SCMSVUT1",374,0) ; "RTN","SCMSVUT1",375,0) PRDSER(DATA) ; "RTN","SCMSVUT1",376,0) ;INPUT DATA - period of service to be tested. "RTN","SCMSVUT1",377,0) ; "RTN","SCMSVUT1",378,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",379,0) I DATA="" Q 0 "RTN","SCMSVUT1",380,0) I '$D(^DIC(21,"D",DATA)) Q 0 "RTN","SCMSVUT1",381,0) Q 1 "RTN","SCMSVUT1",382,0) ; "RTN","SCMSVUT1",383,0) VIETSER1(DATA) ; "RTN","SCMSVUT1",384,0) ;INPUT DATA - Vietnam service to be checked "RTN","SCMSVUT1",385,0) ; "RTN","SCMSVUT1",386,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",387,0) I DATA="" Q 1 "RTN","SCMSVUT1",388,0) I DATA'="Y",DATA'="N",DATA'="U" Q 0 "RTN","SCMSVUT1",389,0) Q 1 "RTN","SCMSVUT1",390,0) ; "RTN","SCMSVUT1",391,0) VIETSER2(DATA,DFN) ; "RTN","SCMSVUT1",392,0) ;INPUT DATA - Vietnam service to be checked against vet status "RTN","SCMSVUT1",393,0) ; "RTN","SCMSVUT1",394,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",395,0) N VAR "RTN","SCMSVUT1",396,0) S VAR=$G(^DPT(DFN,"VET")) "RTN","SCMSVUT1",397,0) I DATA="",VAR'="Y" Q 1 "RTN","SCMSVUT1",398,0) I (DATA="Y"!(DATA="N")!(DATA="U")),VAR="Y" Q 1 "RTN","SCMSVUT1",399,0) Q 0 "RTN","SCMSVUT1",400,0) ; "RTN","SCMSVUT1",401,0) ACTPRD(DATA) ; "RTN","SCMSVUT1",402,0) ;INPUT DATA - period of serivce indicator to be check to ensure active "RTN","SCMSVUT1",403,0) ; "RTN","SCMSVUT1",404,0) N VAR "RTN","SCMSVUT1",405,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",406,0) I DATA="" Q 0 "RTN","SCMSVUT1",407,0) S VAR=+$O(^DIC(21,"D",DATA,0)) "RTN","SCMSVUT1",408,0) S VAR=$P($G(^DIC(21,VAR,0)),U,8) "RTN","SCMSVUT1",409,0) I VAR Q 0 "RTN","SCMSVUT1",410,0) Q 1 "RTN","SCMSVUT1",411,0) ; "RTN","SCMSVUT1",412,0) PCODMTHD(DATA) ; "RTN","SCMSVUT1",413,0) ;INPUT DATA - The coding method to be checked. "RTN","SCMSVUT1",414,0) ; "RTN","SCMSVUT1",415,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",416,0) I DATA'="C4" Q 0 "RTN","SCMSVUT1",417,0) Q 1 "RTN","SCMSVUT1",418,0) ; "RTN","SCMSVUT1",419,0) PROCCOD(DATA,ENCDT) ; "RTN","SCMSVUT1",420,0) ;INPUT DATA - The procedure code to be checked. "RTN","SCMSVUT1",421,0) ;This call makes the assumption that leading zeros are intact in the "RTN","SCMSVUT1",422,0) ;input. "RTN","SCMSVUT1",423,0) ; "RTN","SCMSVUT1",424,0) N VAR "RTN","SCMSVUT1",425,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",426,0) I DATA="" Q 0 "RTN","SCMSVUT1",427,0) ;S VAR=+$O(^ICPT("B",DATA,"")) "RTN","SCMSVUT1",428,0) ;I '$D(^ICPT(VAR,0)) Q 0 "RTN","SCMSVUT1",429,0) ; "RTN","SCMSVUT1",430,0) ; CSV - pass encounter date to API "RTN","SCMSVUT1",431,0) ;I $$CPT^ICPTCOD(DATA,,1)'>0 Q 0 "RTN","SCMSVUT1",432,0) I $$CPT^ICPTCOD(DATA,ENCDT,1)'>0 Q 0 "RTN","SCMSVUT1",433,0) Q 1 "RTN","SCMSVUT1",434,0) ; "RTN","SCMSVUT1",435,0) PROVCLS(DATA) ; "RTN","SCMSVUT1",436,0) ;INPUT DATA - The practitioner class to be checked. "RTN","SCMSVUT1",437,0) ; "RTN","SCMSVUT1",438,0) I '$D(DATA) Q 0 "RTN","SCMSVUT1",439,0) I DATA="" Q 0 "RTN","SCMSVUT1",440,0) I $$CODE2TXT^XUA4A72(DATA)']"" Q 0 "RTN","SCMSVUT1",441,0) Q 1 "RTN","SCMSVUT1",442,0) ; "RTN","SCRPW18") 0^7^B55681496 "RTN","SCRPW18",1,0) SCRPW18 ;RENO/KEITH/MRY - ACRP encounter consistency checker ; 21 JUL 2000 2:17 PM "RTN","SCRPW18",2,0) ;;5.3;Scheduling;**139,144,155,222,387**;AUG 13, 1993 "RTN","SCRPW18",3,0) CHEK(ENCPTR,SDARY,SDSTR) ;Consistency checker for outpatient encounter transactions "RTN","SCRPW18",4,0) ;Required input: ENCPTR=OUTPATIENT ENCOUNTER record IEN "RTN","SCRPW18",5,0) ;Required input: SDARY=array (passed by reference) of HL7 segments to "RTN","SCRPW18",6,0) ; check in the format SDARY(segmentname)="". Returns "RTN","SCRPW18",7,0) ; SDARY(segmentname)="", if no errors for that segment. "RTN","SCRPW18",8,0) ; If errors exist for a specific segment, returns: "RTN","SCRPW18",9,0) ; "RTN","SCRPW18",10,0) ; SDARY(segment)="-1^Element in xxx segment failed validity check" "RTN","SCRPW18",11,0) ; SDARY(segment,errorcode)=error code description (from file #409.76) "RTN","SCRPW18",12,0) ; "RTN","SCRPW18",13,0) ; If passed in as an undefined array, all segments will "RTN","SCRPW18",14,0) ; be checked; otherwise, only segment names "RTN","SCRPW18",15,0) ; in the array subscript will be checked. "RTN","SCRPW18",16,0) ;Optional input: SDSTR array as established by SEG^SCRPW18 "RTN","SCRPW18",17,0) ;Output: 1=inconsistencies found, 0=no inconsistencies found "RTN","SCRPW18",18,0) ; "RTN","SCRPW18",19,0) N HL,HLEID,ENCDT,EVNTDATE,EVNTHL7,SEG,DELPTR,SDERR,DFN,VAFSTR,NODE,SDE1,SDI,SDX,VALERR,XMITPTR,ENCNDT S VALERR="SDE1",XMITPTR="" "RTN","SCRPW18",20,0) D:$D(SDSTR)<10 STR(.SDSTR) I $D(SDARY)<10 S SEG="" F S SEG=$O(SDSTR(SEG)) Q:SEG="" S SDARY(SEG)="" "RTN","SCRPW18",21,0) S NODE=$$GETOE^SDOE(ENCPTR) Q:'$L(NODE) 0 S DFN=$P(NODE,U,2) "RTN","SCRPW18",22,0) S SDERR=0,DELPTR="",HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0)),ENCDT=$P($P(NODE,U),"."),EVNTDATE=$P(NODE,U),ENCNDT=EVNTDATE,EVNTHL7="A08" D INIT^HLFNC2(HLEID,.HL) "RTN","SCRPW18",23,0) S SEG="" F S SEG=$O(SDARY(SEG)) Q:SEG="" S VAFSTR=$G(SDSTR(SEG)) I $L(VAFSTR) D VER(SEG,VAFSTR,.SDARY,.SDERR) K @("VAF"_SEG) "RTN","SCRPW18",24,0) Q SDERR "RTN","SCRPW18",25,0) ; "RTN","SCRPW18",26,0) VER(SEG,VAFSTR,SDARY,SDERR) ;Verify a segment "RTN","SCRPW18",27,0) ;Required input: SEG=segment name "RTN","SCRPW18",28,0) ;Required input: VAFSTR=segment string "RTN","SCRPW18",29,0) ;Required input: SDARY=array for error return "RTN","SCRPW18",30,0) ;Required input: SDERR=variable to return error status (pass by reference) "RTN","SCRPW18",31,0) ;Output: SDARY(SEG)=error (if one exists) "RTN","SCRPW18",32,0) N VAFARRY,TAG,ERROR,ERRSUB S SDARY(SEG)="" "RTN","SCRPW18",33,0) K ^TMP("SCRPWVER",$J) S VAFARRY="^TMP(""SCRPWVER"","_$J_","""_SEG_""")" S ERROR=0 F TAG="BLD"_SEG_"^SCDXMSG1","VLD"_SEG_"^SCDXMSG1" D @TAG "RTN","SCRPW18",34,0) K ^TMP("SCRPWVER",$J) I ERROR'=0 S SDARY(SEG)=ERROR,SDERR=1,SDI="" F S SDI=$O(SDE1(SEG,SDI)) Q:SDI="" S SDX=SDE1(SEG,SDI),SDARY(SEG,SDX)=$P($G(^SD(409.76,+$O(^SD(409.76,"B",SDX,"")),1)),U) "RTN","SCRPW18",35,0) Q "RTN","SCRPW18",36,0) ; "RTN","SCRPW18",37,0) STR(SDSTR) ;Create segment string "RTN","SCRPW18",38,0) ;Required input: SDSEG=array to return segment strings (pass by reference) "RTN","SCRPW18",39,0) ;Output: array of segments and strings in the format SDSTR(segment)=segment string "RTN","SCRPW18",40,0) N SDI,SDSEG "RTN","SCRPW18",41,0) D SEGMENTS^SCDXMSG1("A08","SDSTR") S SDI=0 F S SDI=$O(SDSTR(SDI)) Q:'SDI S SDSEG=$O(SDSTR(SDI,"")),SDSTR(SDSEG)=SDSTR(SDI,SDSEG) K SDSTR(SDI,SDSEG) "RTN","SCRPW18",42,0) Q "RTN","SCRPW18",43,0) ; "RTN","SCRPW18",44,0) SEGS(SDARY) ;Return segments to validate "RTN","SCRPW18",45,0) ;Optional input: SDARY=array to return list of segments in "RTN","SCRPW18",46,0) ;Output: string of HL7 segments to validate "RTN","SCRPW18",47,0) N SD,SDS,SDL "RTN","SCRPW18",48,0) S SDS="PID^ZIR^ZEL^ZPD^ZSP^DG1^PR1^ZCL^ZSC^ROL^" "RTN","SCRPW18",49,0) K SDARY F SDL=1:1 S SD=$P(SDS,U,SDL) Q:SD="" S SDARY(SD)="" "RTN","SCRPW18",50,0) Q SDS "RTN","SCRPW18",51,0) ; "RTN","SCRPW18",52,0) ;Modules to print the Encounter 'Action Required' Report "RTN","SCRPW18",53,0) DET ;Print detail "RTN","SCRPW18",54,0) S SDT(1)="<*> ENCOUNTER 'ACTION REQUIRED' REPORT <*>",SDFF=0,SDCG="" F S SDCG=$O(^TMP("SCRPW",$J,SDIV,1,SDCG)) Q:SDCG="" D HDR(.SDT,"D") Q:SDOUT W:SD("FORMAT")="AG" !?2,"Clinic group: ",SDCG D TPRT "RTN","SCRPW18",55,0) Q "RTN","SCRPW18",56,0) ; "RTN","SCRPW18",57,0) TPRT S SDCLN="" F S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN)) Q:SDCLN=""!SDOUT D:(SDFF&$G(SD("PAGE"))!($Y>(IOSL-6))) HDR(.SDT,"D") Q:SDOUT W !!?8,"Clinic: ",SDCLN S SDFF=1 D PPRT "RTN","SCRPW18",58,0) Q "RTN","SCRPW18",59,0) ; "RTN","SCRPW18",60,0) PPRT S SDORD="" F S SDORD=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD)) Q:SDORD=""!SDOUT S DFN="" F S DFN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN)) Q:DFN=""!SDOUT D PP1 "RTN","SCRPW18",61,0) Q "RTN","SCRPW18",62,0) ; "RTN","SCRPW18",63,0) PP1 S SDPT0=^TMP("SCRPW",$J,SDIV,3,DFN),SDPTNA=$P(SDPT0,U),SDSN=$P(SDPT0,U,3) "RTN","SCRPW18",64,0) S SDOE=0 F S SDOE=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0) D ETCO,PP2 "RTN","SCRPW18",65,0) Q "RTN","SCRPW18",66,0) ; "RTN","SCRPW18",67,0) PP2 S SDCT=2,SDI="" F S SDI=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDI)) Q:SDI="" S SDCT=SDCT+1 "RTN","SCRPW18",68,0) D:$Y>(IOSL-SDCT) HDR(.SDT,"D") Q:SDOUT W !!,$E(SDPTNA,1,24),?26,SDSN S Y=$P(SDOE0,U) X ^DD("DD") W ?39,$P(Y,":",1,2),?58,SDTY,?81,$E(SDCI,1,25),?107,$E(SDCO,1,25) "RTN","SCRPW18",69,0) S SDCT=0,SDI="" F S SDI=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDI)) Q:SDI=""!SDOUT D "RTN","SCRPW18",70,0) .W ! W:'SDCT ?8,"Required elements:" S SDX=^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN,SDORD,DFN,SDOE,SDI) W ?27,$$DEF(SDX,104) S SDCT=SDCT+1 "RTN","SCRPW18",71,0) .Q "RTN","SCRPW18",72,0) Q "RTN","SCRPW18",73,0) ; "RTN","SCRPW18",74,0) ETCO S (SDTY,SDCI,SDCO)="" D:$P(SDOE0,U,8)=1 ETAP D:$P(SDOE0,U,8)=2 ETAE D:$P(SDOE0,U,8)=3 ETDIS Q "RTN","SCRPW18",75,0) ; "RTN","SCRPW18",76,0) ETDIS S SDTY="DISPOSITION",SDDIS=$P(SDOE0,U,9),SDDIS=$G(^DPT(DFN,"DIS",+SDDIS,0)),SDCI=$P(SDDIS,U,5),SDCI=$P($G(^VA(200,+SDCI,0)),U),SDCO=$P(SDDIS,U,9),SDCO=$P($G(^VA(200,+SDCO,0)),U) Q "RTN","SCRPW18",77,0) ; "RTN","SCRPW18",78,0) ETAP S SDAP0=$G(^DPT(DFN,"S",$P(SDOE0,U),0)) Q:'$L(SDAP0) S SDCL=$P(SDAP0,U) Q:SDCL'=$P(SDOE0,U,4) "RTN","SCRPW18",79,0) S X=$P(SDAP0,U,7),SDTY=$S(X=3:"SCHEDULED APPOINTMENT",X=4:"UNSCHEDULED VISIT",X=2:"10-10 VISIT",X=1:"C&P APPOINTMENT",1:"") "RTN","SCRPW18",80,0) S SDCLPT=0 F S SDCLPT=$O(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT)) Q:'SDCLPT Q:$P(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT,0),U)=DFN "RTN","SCRPW18",81,0) Q:'SDCLPT I SDTY["UNSCH" S SDCI=$P(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT,0),U,6) S:SDCI SDCI=$P($G(^VA(200,SDCI,0)),U) "RTN","SCRPW18",82,0) S SDCLPTC=$G(^SC(SDCL,"S",$P(SDOE0,U),1,SDCLPT,"C")) Q:'$L(SDCLPTC) I $P(SDCLPTC,U,2) S SDCI=$P($G(^VA(200,+$P(SDCLPTC,U,2),0)),U) "RTN","SCRPW18",83,0) I $P(SDCLPTC,U,4) S SDCO=$P($G(^VA(200,+$P(SDCLPTC,U,4),0)),U) "RTN","SCRPW18",84,0) Q "RTN","SCRPW18",85,0) ; "RTN","SCRPW18",86,0) ETAE S SDTY="ADD/EDIT ENCOUNTER",SDV=$P(SDOE0,U,5),SDCO=$P($G(^AUPNVSIT(+SDV,0)),U,23),SDCO=$P($G(^VA(200,+SDCO,0)),U) "RTN","SCRPW18",87,0) Q "RTN","SCRPW18",88,0) ; "RTN","SCRPW18",89,0) T2() Q:SD("FORMAT")="AC" "For all clinics" Q:SD("FORMAT")="SC" "For selected clinics" "RTN","SCRPW18",90,0) I SD("FORMAT")="RC" N SDC,SDX S SDC=$O(SD("CLINIC","")),SDX="For range of clinics: "_SDC,SDC=$O(SD("CLINIC",SDC)) Q SDX_" to "_SDC "RTN","SCRPW18",91,0) I SD("FORMAT")="SS" N SDX,SDI S SDX="" D Q SDX "RTN","SCRPW18",92,0) .S SDI=0 F S SDI=$O(SD("STOPCODE",SDI)) Q:'SDI S SDX=SDX_", "_SDI "RTN","SCRPW18",93,0) .S SDI=$S($L(SDX,", ")>11:", ",1:"") "RTN","SCRPW18",94,0) .S SDX="For selected Stop Codes: "_$P(SDX,", ",2,11)_SDI "RTN","SCRPW18",95,0) .Q "RTN","SCRPW18",96,0) I SD("FORMAT")="RS" N SDX,SDI S SDI=$O(SD("STOPCODE","")),SDX="For range of Stop Codes: "_SDI,SDI=$O(SD("STOPCODE",SDI)) Q SDX_" to "_SDI "RTN","SCRPW18",97,0) Q:SD("FORMAT")="AG" "For all clinic groups" Q "For clinic group: "_$P(SD("GROUP"),U,2) "RTN","SCRPW18",98,0) ; "RTN","SCRPW18",99,0) HD1 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDLINE="",$P(SDLINE,"-",133)="",Y=SD("BDT") X ^DD("DD") S SDBDAY=Y,Y=$P(SD("EDT"),".") X ^DD("DD") S SDEDAY=Y,SDPAGE=1 Q "RTN","SCRPW18",100,0) ; "RTN","SCRPW18",101,0) HDR(SDT,SDR) ;Print header "RTN","SCRPW18",102,0) ;Required input: SDT=array of report titles "RTN","SCRPW18",103,0) ;Required input: SDR=report type "RTN","SCRPW18",104,0) D STOP^SCRPW16 Q:SDOUT "RTN","SCRPW18",105,0) I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT "RTN","SCRPW18",106,0) N SDI W:SDPAGE'=1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE S SDI=0 F S SDI=$O(SDT(SDI)) Q:'SDI W !?(132-$L(SDT(SDI))\2),SDT(SDI) "RTN","SCRPW18",107,0) W !,SDLINE,!,"For date range: ",SDBDAY," to ",SDEDAY,!,"Date printed: ",SDPNOW,?(126-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 "RTN","SCRPW18",108,0) I SDR="D" W !,"Patient:",?26,"SSN:",?39,"Date/time:",?58,"Type:",?81,"Check-in user:",?107,"Check-out user:",!,SDLINE "RTN","SCRPW18",109,0) Q "RTN","SCRPW18",110,0) ; "RTN","SCRPW18",111,0) STAT ;Print statistics "RTN","SCRPW18",112,0) S SDT(1)="<*> ENCOUNTER 'ACTION REQUIRED' STATISTICS <*>" D HDR(.SDT,"S") S SDCG="" F S SDCG=$O(^TMP("SCRPW",$J,SDIV,1,SDCG)) Q:SDCG="" D ST1 "RTN","SCRPW18",113,0) D:$Y>(IOSL-3) HDR(.SDT,"S") W !!?35,$S(SDIV:"DIVISION",1:"TOTAL")," 'ACTION REQUIRED' ENCOUNTERS IDENTIFIED: ",SDFCT(SDIV) Q "RTN","SCRPW18",114,0) ; "RTN","SCRPW18",115,0) ST1 I SD("FORMAT")["G" D:$Y>(IOSL-7) HDR(.SDT,"S") S SDX="Clinic group: "_SDCG W !!?(132-$L(SDX)\2),SDX,! "RTN","SCRPW18",116,0) D REASON D:$Y>(IOSL-4) HDR(.SDT,"S") W !!?35,"Clinic:" "RTN","SCRPW18",117,0) S SDCLN="" F S SDCLN=$O(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN)) Q:SDCLN="" D:$Y>(IOSL-2) HDR(.SDT,"S") W !?35,SDCLN,?89,$J(^TMP("SCRPW",$J,SDIV,1,SDCG,SDCLN),6) "RTN","SCRPW18",118,0) I SD("FORMAT")["G" D:$Y>(IOSL-3) HDR(.SDT,"S") S SDX="Total for clinic group "_SDCG_": "_^TMP("SCRPW",$J,SDIV,1,SDCG) W !!?(132-$L(SDX)\2),SDX,!?35,$E(SDLINE,1,60),! "RTN","SCRPW18",119,0) Q "RTN","SCRPW18",120,0) ; "RTN","SCRPW18",121,0) REASON D:$Y>(IOSL-4) HDR(.SDT,"S") W !?35,"Reason:" S SDI="" "RTN","SCRPW18",122,0) F S SDI=$O(^TMP("SCRPW",$J,SDIV,2,SDCG,SDI)) Q:SDI="" D:$Y>(IOSL-3) HDR(.SDT,"S") W !?35,$$DEF(SDI,52),?89,$J(^TMP("SCRPW",$J,SDIV,2,SDCG,SDI),6) "RTN","SCRPW18",123,0) W ! Q "RTN","SCRPW18",124,0) ; "RTN","SCRPW18",125,0) DEF(SDX,SDL) ;Produce deficiency external value "RTN","SCRPW18",126,0) ;Required input: SDX=error code or value "RTN","SCRPW18",127,0) ;Required input; SDL=maximum length of output string "RTN","SCRPW18",128,0) Q:'$D(^SD(409.76,"B",SDX)) $E(SDX,1,SDL) "RTN","SCRPW18",129,0) N SDERR S SDERR=$$ERRSUB^SCRPW17(SDX) I SDERR'="" Q $E(SDERR,1,SDL) "RTN","SCRPW18",130,0) N SDV S SDV=$P($G(^SD(409.76,+$O(^SD(409.76,"B",SDX,"")),1)),U) "RTN","SCRPW18",131,0) Q $S($L(SDV):$E(SDV,1,SDL),1:$E(SDX,1,SDL)) "RTN","SD53P387") 0^^B1570780 "RTN","SD53P387",1,0) SD53P387 ;ALB/JAM - AMBCARE POST INIT ROUTINE ; 09/15/04 "RTN","SD53P387",2,0) ;;5.3;Scheduling;**387**;Aug 13, 1993 "RTN","SD53P387",3,0) EN ;entry point for post init "RTN","SD53P387",4,0) ;Update error code 4200 by adding an additional parameter "RTN","SD53P387",5,0) N DIE,DA,DR,X,Y,SDIEN,SDAT "RTN","SD53P387",6,0) D BMES^XPDUTL("*****") "RTN","SD53P387",7,0) D MES^XPDUTL("Update to Ambcare VISTA Error Code 4200 at 'CHK' Level") "RTN","SD53P387",8,0) D MES^XPDUTL("CHK level will be updated to S RES=$$ENCDT^SCMSVUT1(DATA,XMTFLG)") "RTN","SD53P387",9,0) S SDIEN=$O(^SD(409.76,"B",4200,0)) "RTN","SD53P387",10,0) I +SDIEN<1 D Q "RTN","SD53P387",11,0) .D BMES^XPDUTL(" Error Code 4200 does not exist. No update done.") "RTN","SD53P387",12,0) .D BMES^XPDUTL("*****") "RTN","SD53P387",13,0) S SDAT=$G(^SD(409.76,SDIEN,"CHK")) "RTN","SD53P387",14,0) D BMES^XPDUTL(" Current Value: "_SDAT) "RTN","SD53P387",15,0) S DIE=409.76,DA=SDIEN,DR="31////S RES=$$ENCDT^SCMSVUT1(DATA,XMTFLG)" "RTN","SD53P387",16,0) D ^DIE "RTN","SD53P387",17,0) S SDAT=$G(^SD(409.76,SDIEN,"CHK")) "RTN","SD53P387",18,0) D MES^XPDUTL(" Updated Value: "_SDAT) "RTN","SD53P387",19,0) D BMES^XPDUTL("*****") "RTN","SD53P387",20,0) Q "RTN","SDAMBMR2") 0^6^B25248772 "RTN","SDAMBMR2",1,0) SDAMBMR2 ;ALB/MLI - PRINT AMBULATORY PROCEDURES MANAGEMENT REPORTS ; 4/27/00 12:14pm "RTN","SDAMBMR2",2,0) ;;5.3;Scheduling;**28,140,132,180,339,387**;Aug 13, 1993 "RTN","SDAMBMR2",3,0) HD S SDPG=SDPG+1 W @IOF,!?20,"AMBULATORY PROCEDURE MANAGEMENT REPORTS",!!,"DATE RANGE: ",SDB,"-",SDE,?50,"DATE PRINTED: ",SDNOW,!,$S(SDFL:SDSTR_" NAME:",1:"ALL "_SDSTR_"S"),?16,SDT,?71,"PAGE: ",$J(SDPG,3) Q "RTN","SDAMBMR2",4,0) DT S SDB=SDB+.1,SDE=SDE-.9,SDB=$TR($$FMTE^XLFDT(SDB,"5DF")," ","0"),SDE=$TR($$FMTE^XLFDT(SDE,"5DF")," ","0") Q "RTN","SDAMBMR2",5,0) 1 S SDSTR=$S(SDSC="C":"CLINIC",1:"SERVICE") D DT G 2:SDRT="E" I SDSC="C" S I=0 F I1=0:0 S I=$S(VAUTC:$O(^TMP($J,I)),1:$O(VAUTC(I))) Q:I=""!SDFG I $D(^TMP($J,I,"T")),^("T") S SDT=I,SDFL=1 D P^SDAMBMR3 Q:SDFG "RTN","SDAMBMR2",6,0) I SDSC="S" F I="M","N","P","R","S" I SDAS!$D(SDS(I)) I ^TMP($J,I,"T") D SET,P^SDAMBMR3 Q:SDFG "RTN","SDAMBMR2",7,0) D TOT Q "RTN","SDAMBMR2",8,0) 2 G 3:SDPN="N" S I=0 "RTN","SDAMBMR2",9,0) F I1=0:0 D:I'=0 P^SDAMBMR3 Q:SDFG S I=$O(^TMP($J,"*PRO",I)) Q:I=""!(SDSC="S"&I)!SDFG D SET,HD2 Q:SDFG F J=0:0 D:J T S J=$O(^TMP($J,"*PRO",I,J)) Q:J="" D CD,PN:SDPT=1 D:$Y>(IOSL-5) HD2 Q:SDFG "RTN","SDAMBMR2",10,0) D TOT Q "RTN","SDAMBMR2",11,0) 3 S (SDFL,I)=0,SDSTR=$S(SDSC="C":"CLINIC",1:"SERVICE") "RTN","SDAMBMR2",12,0) F I1=0:0 D:SDFL P^SDAMBMR3 S SDFL=0,I=$O(^TMP($J,"*PTC",I)) Q:I=""!SDFG D SET,HD3 Q:SDFG D CONT "RTN","SDAMBMR2",13,0) D TOT Q "RTN","SDAMBMR2",14,0) CONT S J=0 F J1=0:0 S J=$O(^TMP($J,"*PTC",I,J)) Q:J=""!SDFG S K=0 F K1=0:0 S K=$O(^TMP($J,"*PTC",I,J,K)) Q:K="" D C D:$Y>(IOSL-5) HD3 Q:SDFG "RTN","SDAMBMR2",15,0) Q "RTN","SDAMBMR2",16,0) PN S L=0,K="A" "RTN","SDAMBMR2",17,0) F K1=0:0 S K=$O(^TMP($J,"*PRO",I,J,K)) Q:K=""!SDFG F L1=0:0 S L=$O(^TMP($J,"*PRO",I,J,K,L)) Q:L=""!SDFG F M=0:0 S M=$O(^TMP($J,"*PRO",I,J,K,L,M)) Q:M="" S SDINFO=^(M) D PNAME D:$Y>(IOSL-5) HD2 Q:SDFG "RTN","SDAMBMR2",18,0) Q "RTN","SDAMBMR2",19,0) ; "RTN","SDAMBMR2",20,0) PNAME N % "RTN","SDAMBMR2",21,0) F %=1:1:$P(SDINFO,U,4) W !,?8,$E(K,1,18),?28,$P(SDINFO,U,10),?39,"AGE: ",$J($P(SDINFO,U,2),3),?49,$S($P(SDINFO,U)=1:"VETERAN",1:"NON-VET"),?58,$P(SDINFO,U,3),?61 S VADAT("W")=M D ^VADATE W VADATE("E") "RTN","SDAMBMR2",22,0) Q "RTN","SDAMBMR2",23,0) ; "RTN","SDAMBMR2",24,0) ;If prompt "Sort by 'P'rocedure or patient 'N'ame: P//PROCEDURE" "RTN","SDAMBMR2",25,0) ;CPTMOD is called to print Procedure (CPT) codes and associated "RTN","SDAMBMR2",26,0) ;Modifiers. "RTN","SDAMBMR2",27,0) CD N BLKLN,MODCODE,MODINFO,MODTEXT,MODVAL,SDJJ,KK,ICPTVDT "RTN","SDAMBMR2",28,0) S (BLKLN,MODVAL)=0,SDHI=I D HD2:($Y>(IOSL-5)) Q:SDFG "RTN","SDAMBMR2",29,0) S %DT="X",X=SDE D ^%DT S ICPTVDT=$S(Y<0:DT,1:Y) "RTN","SDAMBMR2",30,0) S J=$P($$CPT^ICPTCOD(J,ICPTVDT),"^",1) ; equals IEN for CPT "RTN","SDAMBMR2",31,0) S KK=$P($$CPT^ICPTCOD(J,ICPTVDT),"^",2) ; SD*5.3*339 external CPT value "RTN","SDAMBMR2",32,0) W !!,$G(KK) ; SD*5.3*339 print external CPT code "RTN","SDAMBMR2",33,0) S I=J D N W ?7,$E(SDN,1,72) S I=SDHI "RTN","SDAMBMR2",34,0) Q:'SDMOD "RTN","SDAMBMR2",35,0) I $D(^TMP($J,"*PRO",I,J,0)) S MODVAL=$P(^TMP($J,"*PRO",I,J,0),"^",2,99) "RTN","SDAMBMR2",36,0) I $D(^TMP($J,"*PRO",I,J,1)) S MODVAL=$P(^TMP($J,"*PRO",I,J,1),"^",2,99) "RTN","SDAMBMR2",37,0) Q:'MODVAL "RTN","SDAMBMR2",38,0) F SDJJ=1:1:$L(MODVAL,"^") S MODINFO=$P(MODVAL,"^",SDJJ) D "RTN","SDAMBMR2",39,0) . S MODINFO=$$MOD^ICPTMOD(MODINFO,"I",ICPTVDT,1) "RTN","SDAMBMR2",40,0) . Q:MODINFO'>0 "RTN","SDAMBMR2",41,0) . S MODCODE="-"_$P(MODINFO,"^",2) "RTN","SDAMBMR2",42,0) . S MODTEXT=$P(MODINFO,"^",3) "RTN","SDAMBMR2",43,0) . W !?2,MODCODE,?8,$E(MODTEXT,1,65) "RTN","SDAMBMR2",44,0) . Q "RTN","SDAMBMR2",45,0) W ! "RTN","SDAMBMR2",46,0) Q "RTN","SDAMBMR2",47,0) HD2 Q:SDFG I IOST?1"C-".E R !?20,"Enter to continue",SDFG1:DTIME I SDFG1["^"!'$T S SDFG=1 Q "RTN","SDAMBMR2",48,0) D HD W !!?25,"SUMMARY OF PROCEDURES PERFORMED",! K Y S $P(Y,"-",81)="" W Y Q "RTN","SDAMBMR2",49,0) HD3 Q:SDFG I IOST?1"C-".E R !?20,"Enter to continue",SDFG1:DTIME I SDFG1["^"!'$T S SDFG=1 Q "RTN","SDAMBMR2",50,0) D HD W !!?31,"SUMMARY BY PATIENT",!,"NAME",?27,"SSN",?38,"AGE",?43,"VET/NON",?53,"SEX",?60,"DATE/TIME OF STOP",! K Y S $P(Y,"-",81)="" W Y "RTN","SDAMBMR2",51,0) SET S SDT=$S(SDSC="C":I,I="M":"MEDICINE",I="N":"NEUROLOGY",I="P":"PSYCHIATRY",I="R":"REHAB MEDICINE",I="S":"SURGERY",I="Z":"NONE",1:"UNKNOWN"),SDFL=1 Q "RTN","SDAMBMR2",52,0) T W !?8,"TOTAL PROCEDURES==>",?30,"VETERAN:",?39,$J($S($D(^TMP($J,"*PRO",I,J,1)):$P(^(1),"^",1),1:0),4),?47,"NON-VETERAN:",$J($S($D(^(0)):$P(^(0),"^",1),1:0),4) "RTN","SDAMBMR2",53,0) W ?69,"TOTAL:",?76,$J($S($D(^TMP($J,"*PRO",I,J,0))&$D(^(1)):$P(^(0),"^",1)+$P(^(1),"^",1),'$D(^(0)):$P(^(1),"^",1),1:$P(^(0),"^",1)),4) Q "RTN","SDAMBMR2",54,0) C F L=-1:0 S L=$O(^TMP($J,"*PTC",I,J,K,L)) Q:L="" F M=0:0 S M=$O(^TMP($J,"*PTC",I,J,K,L,M)) Q:M="" M SDINFO=^(M) D C2 "RTN","SDAMBMR2",55,0) Q "RTN","SDAMBMR2",56,0) C2 W !!,$E(J,1,24),?27,$P(SDINFO,U,10) ; 10th piece is ssn "RTN","SDAMBMR2",57,0) W ?38,$P(SDINFO,U),?43,$S(L=1:"VETERAN",1:"NON-VET"),?52,$S($P(SDINFO,U,2)="M":" MALE",1:"FEMALE"),?60 S VADAT("W")=M D ^VADATE W VADATE("E") D LIST "RTN","SDAMBMR2",58,0) Q "RTN","SDAMBMR2",59,0) ; "RTN","SDAMBMR2",60,0) ;If "Sort by 'P'rocedure or patient 'N'ame: P//NAME" the patient name "RTN","SDAMBMR2",61,0) ;,Procedure (CPT) Codes and Modifiers will be printed. "RTN","SDAMBMR2",62,0) LIST N BLKLN,MODCODE,MODINFO,MODTEXT,MODVAL,SDJJ,ICPTVDT "RTN","SDAMBMR2",63,0) S %DT="X",X=SDE D ^%DT S ICPTVDT=$S(Y<0:DT,1:Y) "RTN","SDAMBMR2",64,0) S BLKLN=1 "RTN","SDAMBMR2",65,0) F PR=11:1 S SDPRO=$P(SDINFO,U,PR) Q:'SDPRO D "RTN","SDAMBMR2",66,0) . S SDHI=I D HD:($Y>(IOSL)) Q:SDFG "RTN","SDAMBMR2",67,0) . W !?5,$P($$CPT^ICPTCOD(SDPRO,ICPTVDT),U) S I=SDPRO D N "RTN","SDAMBMR2",68,0) . W ?12,$E(SDN,1,67) S I=SDHI "RTN","SDAMBMR2",69,0) . Q:'SDMOD "RTN","SDAMBMR2",70,0) . S MODVAL=SDINFO(PR-10) "RTN","SDAMBMR2",71,0) . F SDJJ=1:1:$L(MODVAL,"^") S MODINFO=$P(MODVAL,"^",SDJJ) D "RTN","SDAMBMR2",72,0) . . S MODINFO=$$MOD^ICPTMOD(MODINFO,"I",ICPTVDT,1) "RTN","SDAMBMR2",73,0) . . Q:MODINFO'>0 "RTN","SDAMBMR2",74,0) . . S MODCODE="-"_$P(MODINFO,"^",2) "RTN","SDAMBMR2",75,0) . . S MODTEXT=$P(MODINFO,"^",3) "RTN","SDAMBMR2",76,0) . . W !?7,MODCODE,?13,$E(MODTEXT,1,65) "RTN","SDAMBMR2",77,0) . . Q "RTN","SDAMBMR2",78,0) . W ! "RTN","SDAMBMR2",79,0) . Q "RTN","SDAMBMR2",80,0) Q "RTN","SDAMBMR2",81,0) TOT Q:SDFG K I S SDT="",SDFL=0 D P^SDAMBMR3 Q "RTN","SDAMBMR2",82,0) ; "RTN","SDAMBMR2",83,0) ;Retrieves the Procedure (CPT) Code description by calling API "RTN","SDAMBMR2",84,0) ;CPTD^ICPTCOD "RTN","SDAMBMR2",85,0) N N DATA,SDIX,SDDATA,SDCOUNT,ICPTVDT "RTN","SDAMBMR2",86,0) S %DT="X",X=SDE D ^%DT S ICPTVDT=$S(Y<0:DT,1:Y) "RTN","SDAMBMR2",87,0) S SDN="",DATA="" "RTN","SDAMBMR2",88,0) ;F S DATA=$O(DESCR(DATA)) Q:'DATA S SDN=SDN_" "_DESCR(DATA) Q:$L(SDN)>72 "RTN","SDAMBMR2",89,0) ;SDDATA will contain the returned information from the call to CPTD^ICPTCOD. "RTN","SDAMBMR2",90,0) ;This is an extrinsic function, and can't be called with a "Do" statement. "RTN","SDAMBMR2",91,0) S SDDATA=$$CPTD^ICPTCOD(I,"DESCR",,ICPTVDT) "RTN","SDAMBMR2",92,0) S SDCOUNT=$P(SDDATA,"^",1) "RTN","SDAMBMR2",93,0) F SDIX=1:1:SDCOUNT S SDN=SDN_" "_DESCR(SDIX) Q:$L(SDN)>72 "RTN","SDAMBMR2",94,0) S SDN=$E(SDN,1,72) "RTN","SDAMBMR2",95,0) Q "VER") 8.0^22.0 **END** **END**