source: WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDWOR.m@ 1746

Last change on this file since 1746 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.9 KB
Line 
1MDWOR ; HOIFO/NCA - Main Routine to Decode HL7 ;5/23/07 10:49
2 ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
3 ; Reference IA# 2263 [Supported] XPAR calls
4 ; 3071 [Subscription] Call $$PKGID^ORX8.
5 ; 3468 [Subscription] Call GMRCCP.
6 ; 10035 [Supported] Access Patient file DPT
7 ; 10040 [Supported] Hospital Location File SC
8 ; 10103 [Supported] XLFDT calls
9 ;
10EN(MDMSG) ; Entry Point for CPRS and pass MSG in MDMSG
11 N DFN,MDCON,MDCPROC,MDCANC,MDCANR,MDIFN,MDINST,MDINT,MDFLG,MDL,MDIN,MDINP,MDINST,MDLOC,MDNAM,MDOBC,MDOBX,MDOPRO,MDPROC,MDPAT
12 N MDPROV,MDREQ,MDQTIM,MDSINP,MDVSTD,MDX S MDVSTD=""
13 S (MDINP,MDFLG,MDCANC,MDOBC)=0 F MDL=0:0 S MDL=$O(MDMSG(MDL)) Q:MDL<1!(MDFLG) S MDX=$G(MDMSG(MDL)) D
14 .I $E(MDX,1,3)="MSH" D MSH Q
15 .I $E(MDX,1,3)="PID" D PID Q
16 .I $E(MDX,1,3)="PV1" D PV1 Q
17 .I $E(MDX,1,3)="ORC" D ORC Q
18 .I $E(MDX,1,3)="OBR" D OBR Q
19 .I $E(MDX,1,3)="OBX" D:MDOBC<1 OBX Q
20 .Q
21 I 'MDFLG,'MDCANC S MDATA="+1,^"_MDPROC_"^"_+MDCON_"^"_MDINST_"^"_MDVSTD D CHKIN(MDFN,MDREQ,MDPROV,MDATA,MDVSTD)
22 Q
23MSH ; Decode MSH
24 I $P(MDX,"|",2)'="^~\&" S MDFLG=1 Q
25 I $P(MDX,"|",3)'="ORDER ENTRY" S MDFLG=1 Q
26 I $P(MDX,"|",9)'="ORM" S MDFLG=1 Q
27 Q
28PID ; Check PID
29 S MDNAM=$P(MDX,"|",6),DFN=$P(MDX,"|",4)
30 I '$D(^DPT("B",$E(MDNAM,1,30),DFN)) S MDFLG=1
31 S MDFN=DFN
32 Q
33PV1 ; Check PV1
34 S MDPAT=$P(MDX,"|",3) I MDPAT'?1U!("IO"'[MDPAT) S MDFLG=1 Q
35 I MDPAT="I" S MDINP=1
36 S MDLOC=+$P(MDX,"|",4) I $G(^SC(MDLOC,0))="" S MDFLG=1 Q
37 S:MDINP>0 MDLOC=""
38 Q
39ORC ; Check ORC
40 I $P(MDX,"|",2)="NW" D NEW Q
41 I $P(MDX,"|",2)="DC" D CANCEL Q
42 S MDFLG=1
43 Q
44OBX ; Check OBX
45 N %,ANSWER,MDCV,MDOBX
46 S MDOBX=$P(MDX,"|",6)
47 I '+$$GET^XPAR("SYS","MD USE APPT WITH PROCEDURE",1) S MDOBC=MDOBC+1 Q
48 S MDVSTD=$P(MDOBX,"Visit Date: ",2)
49 S MDCV=$P(MDVSTD," ",1,2)
50 I MDCV=""!(MDCV["UNKNOWN") S MDFLG=1 Q
51 S MDVSTD=$P(MDCV," ")_"@"_$P(MDCV," ",2)
52 D DT^DILF("T",MDVSTD,.ANSWER)
53 S:ANSWER<0 ANSWER=""
54 S MDVSTD=ANSWER I MDVSTD="" S MDFLG=1 Q
55 I +MDLOC>0 S MDVSTD="A;"_MDVSTD_";"_MDLOC
56 E D NOW^%DTC S MDVSTD=%
57 S MDOBC=MDOBC+1
58 Q
59NEW ; New Order Segment
60 S MDIFN=+$P(MDX,"|",3) I 'MDIFN S MDFLG=1 Q
61 S MDPROV=+$P(MDX,"|",11) I 'MDPROV S MDFLG=1 Q
62 S MDQTIM=$P(MDX,"|",8),MDQTIM=$P(MDQTIM,"^",6)
63 S MDREQ=$P(MDX,"|",16) S MDREQ=$$FMDTE(MDREQ) I 'MDREQ S MDFLG=1 Q
64 S MDREQ=$S(MDQTIM="Z24":$$FMADD^XLFDT(MDREQ,0,24),MDQTIM="Z48":$$FMADD^XLFDT(MDREQ,0,48),MDQTIM="Z72":$$FMADD^XLFDT(MDREQ,0,72),MDQTIM="ZW":$$FMADD^XLFDT(MDREQ,7),MDQTIM="ZM":$$FMADD^XLFDT(MDREQ,30),1:MDREQ)
65 ; Retrieve Consult Number
66 N MDFDA
67 S MDCON=$$PKGID^ORX8(MDIFN) I 'MDCON S MDFLG=1 Q
68 Q
69OBR ; Check OBR
70 S MDPROC=$P(MDX,"|",5)
71 I $E($P(MDPROC,"^",6),3,5)'["PRC" S MDFLG=1 Q
72 S MDCPROC=$P(MDPROC,"^",4) I 'MDCPROC S MDFLG=1 Q
73 ; Get Procedure for CP IEN
74 S MDPROC=$$CPROC^GMRCCP(MDCPROC) I 'MDPROC S MDFLG=1 Q
75 S MDSINP=$$HIGHV(MDPROC) I '+MDSINP S MDFLG=1 Q
76 S (MDINST,MDINT)=0 F MDIN=0:0 S MDIN=$O(^MDS(702.01,MDPROC,.1,MDIN)) Q:MDIN<1!(+MDINST) S MDINT=+$G(^(MDIN,0)) D
77 .I +$$GET1^DIQ(702.09,+MDINT,".13","I") S MDINST=MDINT Q
78 I +$P(MDSINP,"^",2)=2 D Q
79 .I +MDINP S MDVSTD="",MDOBC=MDOBC+1 Q
80 .S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
81 I +$P(MDSINP,"^",2)=3 D Q
82 .I +MDINP S MDVSTD="",MDOBC=MDOBC+1 Q
83 I +$P(MDSINP,"^",2)=1 D Q
84 .I '+MDINP S MDVSTD="" Q
85 .S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
86 I +MDINP&('$P(^MDS(702.01,MDPROC,0),"^",5)) S MDFLG=1 Q
87 I +MDINP S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
88 S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
89 Q
90CANCEL ; Cancel/Discontinue
91 K MDR S MDIFN=+$P(MDX,"|",3),MDCON=+$P(MDX,"|",4),MDCANC=1
92 I 'MDIFN S MDFLG=1 Q
93 I 'MDCON S MDFLG=1 Q
94 S MDPROV=+$P(MDX,"|",13) I 'MDPROV S MDFLG=1 Q
95 S MDREQ=$P(MDX,"|",16) I 'MDREQ S MDFLG=1 Q
96 S MDINST=$O(^MDD(702,"ACON",MDCON,0)) Q:'MDINST
97 Q:$G(^MDD(702,+MDINST,0))=""
98 I "5"[$P(^MDD(702,+MDINST,0),U,9) S MDCANR=$$CANCEL^MDHL7B(+MDINST)
99 N MDFDA S MDFDA(702,MDINST_",",.09)=6
100 D FILE^DIE("K","MDFDA") K MDFDA
101 N MDHEMO S MDHEMO=+$$GET1^DIQ(702,+MDINST,".04:.06","I")
102 Q:MDHEMO<2
103 Q:$G(^MDK(704.202,+MDINST,0))=""
104 S MDFDA(704.202,+MDINST_",",.09)=0
105 D FILE^DIE("","MDFDA")
106 K ^MDK(704.202,"AS",1,+MDINST)
107 S ^MDK(704.202,"AS",0,+MDINST)=""
108 Q
109CHKIN(MDFN,MDREQ,MDPROV,MDATA,MDVSTD) ; [Procedure] Check In Study
110 N MDX1,MDFDA,MDIEN,MDIENS,MDERR,MDHL7,MDHOLD,MDSCHD,MDMAXD,MDXY,MDNOW
111 F MDX1=2:1:5 D
112 .I $P(MDATA,U,MDX1)]"" S MDFDA(702,$P(MDATA,U,1),$P("^.04^.05^.11^.07",U,MDX1))=$P(MDATA,U,MDX1)
113 ; Remove code after instrument testing available
114 ; End of code removal after instrument available for testin
115 S MDSCHD=$S($L(MDVSTD,";")=1:MDVSTD,1:$P(MDVSTD,";",2)),MDMAXD=DT+.24
116 S MDFDA(702,$P(MDATA,U,1),.09)=$S(MDSCHD="":0,MDSCHD>MDMAXD:0,1:5) ; Status = Checked-In
117 I $P(MDATA,U,1)="+1," D
118 .S MDFDA(702,"+1,",.01)=MDFN
119 .S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
120 .S MDFDA(702,"+1,",.03)=MDPROV
121 .S:+MDSCHD MDFDA(702,"+1,",.14)=MDSCHD
122 .D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR)
123 .Q:MDSCHD>MDMAXD!(MDSCHD="")
124 .S MDIENS=MDIEN(1)_",",MDXY=+$P(MDATA,U,2),MDHOLD="" I +MDXY D
125 ..Q:$P(^MDS(702.01,MDXY,0),U,6)'=2
126 ..S MDHOLD=$P($G(^MDD(702,MDIEN(1),0)),"^",7),MDNOW=$$NOW^XLFDT()
127 ..S $P(^MDD(702,MDIEN(1),0),"^",7)=$S(MDNOW>MDSCHD:MDSCHD,1:MDNOW)
128 .S MDHL7=$$SUB^MDHL7B(MDIEN(1))
129 .I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
130 .I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
131 .D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
132 Q:MDSCHD>MDMAXD!(MDSCHD="")
133 D:+$G(MDIENS)
134 .S MDXY=+$P(MDATA,U,2) Q:'MDXY
135 .I $P(^MDS(702.01,MDXY,0),U,6)=2 D Q ; Renal Check-In
136 ..D CP^MDKUTL(+MDIENS)
137 ..S:$G(MDHOLD)'="" MDFDA(702,+MDIENS_",",.07)=MDHOLD
138 ..S MDFDA(702,+MDIENS_",",.09)=5
139 ..D FILE^DIE("","MDFDA","MDERR")
140 Q
141FMDTE(DATE) ; Convert HL-7 formatted date to a Fileman formatted date
142 N X
143 S X="" I DATE D
144 .S X=$$HL7TFM^XLFDT(DATE,"L")
145 Q X
146HIGHV(MDHV) ; Return flag indicator whether procedure is use for auto check-in
147 N MDANS,MDK,MDKY,MDLST S MDANS=0
148 D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
149 F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1 S MDKY=$G(MDLST(MDK)) D
150 .I MDHV=+$P(MDKY,"^") S MDANS=MDKY
151 Q MDANS
Note: See TracBrowser for help on using the repository browser.