source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDWORC.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1MDWORC ; HOIFO/NCA - Main Routine to Decode HL7 from Consult ;1/8/08 15:00
2 ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
3 ; Reference IA #10035 [Supported] Access Patient file DPT
4 ; 10040 [Supported] Hospital Location File SC
5 ; 10103 [Supported] XLFDT calls
6EN(MDMSG) ; Entry Point for Consult and pass MSG in MDMSG
7 N DFN,MDCON,MDCPROC,MDCANC,MDCANR,MDFN,MDIFN,MDINST,MDFLG,MDL,MDLOC,MDNAM,MDPROC,MDPAT,MDPROV,MDREQ,MDX
8 S (MDFLG,MDCANC)=0 F MDL=0:0 S MDL=$O(MDMSG(MDL)) Q:MDL<1!(MDFLG) S MDX=$G(MDMSG(MDL)) D
9 .I $E(MDX,1,3)="MSH" D MSH Q
10 .I $E(MDX,1,3)="PID" D PID Q
11 .I $E(MDX,1,3)="PV1" D PV1 Q
12 .I $E(MDX,1,3)="ORC" D ORC Q
13 .I $E(MDX,1,3)="NTE" Q
14 .Q
15 Q
16MSH ; Decode MSH
17 I $P(MDX,"|",2)'="^~\&" S MDFLG=1 Q
18 I $P(MDX,"|",3)'="CONSULTS" S MDFLG=1 Q
19 I $P(MDX,"|",9)'="ORM" S MDFLG=1 Q
20 Q
21PID ; Check PID
22 S MDNAM=$P(MDX,"|",6),DFN=$P(MDX,"|",4)
23 I '$D(^DPT("B",$E(MDNAM,1,30),DFN)) S MDFLG=1
24 S MDFN=DFN
25 Q
26PV1 ; Check PV1
27 S MDPAT=$P(MDX,"|",3) I MDPAT'?1U!("IO"'[MDPAT) S MDFLG=1 Q
28 S MDLOC=+$P(MDX,"|",4) I $G(^SC(MDLOC,0))="" S MDFLG=1 Q
29 Q
30ORC ; Check ORC
31 I $P(MDX,"|",2)'="OD",($P(MDX,"|",2)'="OC"),($P(MDX,"|",2)'="XX") Q
32 I $P(MDX,"|",2)="XX" D RESUBM
33 D CANCEL
34 Q
35CANCEL ; Cancel/Discontinue
36 K MDR S MDIFN=+$P(MDX,"|",3),MDCON=+$P(MDX,"|",4)
37 I 'MDIFN S MDFLG=1 Q
38 I 'MDCON S MDFLG=1 Q
39 I $P(MDX,"|",6)'="CA",($P(MDX,"|",6)'="DC") Q
40 S MDPROV=+$P(MDX,"|",13) I 'MDPROV S MDFLG=1 Q
41 S MDREQ=$P(MDX,"|",16) I 'MDREQ S MDFLG=1 Q
42 S MDINST=$O(^MDD(702,"ACON",MDCON,0)) Q:'MDINST
43 Q:$G(^MDD(702,+MDINST,0))=""
44 I "5"[$P(^MDD(702,+MDINST,0),U,9) S MDCANR=$$CANCEL^MDHL7B(+MDINST)
45 N MDFDA S MDFDA(702,+MDINST_",",.09)=6,MDCANC=1
46 D FILE^DIE("K","MDFDA") K MDFDA
47 N MDHEMO S MDHEMO=+$$GET1^DIQ(702,+MDINST,".04:.06","I")
48 Q:MDHEMO<2
49 Q:$G(^MDK(704.202,+MDINST,0))=""
50 S MDFDA(704.202,+MDINST_",",.09)=0
51 D FILE^DIE("","MDFDA")
52 K ^MDK(704.202,"AS",1,+MDINST)
53 S ^MDK(704.202,"AS",0,+MDINST)=""
54 Q
55RESUBM ; Resubmit a cancelled order
56 N MDERR,MDHL7,MDHOLD,MDMAXD,MDNOW,MDSCHD,MDVSTD,MDXY
57 Q:$P(MDX,"|",2)'="XX"
58 K MDR S MDIFN=+$P(MDX,"|",3),MDCON=+$P(MDX,"|",4)
59 I 'MDIFN S MDFLG=1 Q
60 I 'MDCON S MDFLG=1 Q
61 S MDPROV=+$P(MDX,"|",11) I 'MDPROV S MDFLG=1 Q
62 S MDREQ=$P(MDX,"|",16) S:MDREQ MDREQ=$$FMDTE^MDWOR(MDREQ) I 'MDREQ S MDFLG=1 Q
63 S MDINST=$O(^MDD(702,"ACON",MDCON,0)) Q:'MDINST
64 S MDVSTD=$P($G(^MDD(702,MDINST,0)),"^",7)
65 S MDSCHD=$S($L(MDVSTD,";")=1:MDVSTD,1:$P(MDVSTD,";",2)),MDMAXD=DT+.24
66 Q:$$GET1^DIQ(702,MDINST_",",.09,"I")'=6
67 N MDFDA,MDIENS,MDERR
68 S MDFDA(702,MDINST_",",.07)=MDVSTD
69 S MDFDA(702,MDINST_",",.09)=$S(MDSCHD>MDMAXD:0,1:5)
70 D FILE^DIE("K","MDFDA") S MDHOLD="" K MDFDA
71 Q:MDSCHD>MDMAXD
72 S MDXY=$P(^MDD(702,MDINST,0),"^",4)
73 I $P($G(^MDS(702.01,+MDXY,0)),"^",6)=2 S MDHOLD=$P(^MDD(702,MDINST,0),"^",7),MDNOW=$$NOW^XLFDT(),$P(^MDD(702,MDINST,0),"^",7)=$S(MDNOW>MDSCHD:MDSCHD,1:MDNOW)
74 S MDIENS=MDINST_",",MDHL7=$$SUB^MDHL7B(+MDIENS)
75 I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
76 I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
77 D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR") K MDFDA,MDERR
78 N MDHEMO S MDHEMO=+$$GET1^DIQ(702,+MDIENS,".04:.06","I")
79 Q:MDHEMO<2
80 S:$G(MDHOLD)'="" $P(^MDD(702,MDINST,0),"^",7)=MDHOLD
81 Q:$G(^MDK(704.202,+MDINST,0))=""
82 S MDFDA(704.202,+MDINST_",",.09)=1
83 D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR") K MDFDA,MDERR
84 K ^MDK(704.202,"AS",0,+MDINST)
85 S ^MDK(704.202,"AS",1,+MDINST)=""
86 Q
Note: See TracBrowser for help on using the repository browser.