MDWORC	; HOIFO/NCA - Main Routine to Decode HL7 from Consult ;1/8/08  15:00
	;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
	; Reference IA #10035 [Supported] Access Patient file DPT
	;               10040 [Supported] Hospital Location File SC
	;               10103 [Supported] XLFDT calls
EN(MDMSG)	; Entry Point for Consult and pass MSG in MDMSG
	N DFN,MDCON,MDCPROC,MDCANC,MDCANR,MDFN,MDIFN,MDINST,MDFLG,MDL,MDLOC,MDNAM,MDPROC,MDPAT,MDPROV,MDREQ,MDX
	S (MDFLG,MDCANC)=0 F MDL=0:0 S MDL=$O(MDMSG(MDL)) Q:MDL<1!(MDFLG)  S MDX=$G(MDMSG(MDL)) D
	.I $E(MDX,1,3)="MSH" D MSH Q
	.I $E(MDX,1,3)="PID" D PID Q
	.I $E(MDX,1,3)="PV1" D PV1 Q
	.I $E(MDX,1,3)="ORC" D ORC Q
	.I $E(MDX,1,3)="NTE" Q
	.Q
	Q
MSH	; Decode MSH
	I $P(MDX,"|",2)'="^~\&" S MDFLG=1 Q
	I $P(MDX,"|",3)'="CONSULTS" S MDFLG=1 Q
	I $P(MDX,"|",9)'="ORM" S MDFLG=1 Q
	Q
PID	; Check PID
	S MDNAM=$P(MDX,"|",6),DFN=$P(MDX,"|",4)
	I '$D(^DPT("B",$E(MDNAM,1,30),DFN)) S MDFLG=1
	S MDFN=DFN
	Q
PV1	; Check PV1
	S MDPAT=$P(MDX,"|",3) I MDPAT'?1U!("IO"'[MDPAT) S MDFLG=1 Q
	S MDLOC=+$P(MDX,"|",4) I $G(^SC(MDLOC,0))="" S MDFLG=1 Q
	Q
ORC	; Check ORC
	I $P(MDX,"|",2)'="OD",($P(MDX,"|",2)'="OC"),($P(MDX,"|",2)'="XX") Q
	I $P(MDX,"|",2)="XX" D RESUBM
	D CANCEL
	Q
CANCEL	; Cancel/Discontinue
	K MDR S MDIFN=+$P(MDX,"|",3),MDCON=+$P(MDX,"|",4)
	I 'MDIFN S MDFLG=1 Q
	I 'MDCON S MDFLG=1 Q
	I $P(MDX,"|",6)'="CA",($P(MDX,"|",6)'="DC") Q
	S MDPROV=+$P(MDX,"|",13) I 'MDPROV S MDFLG=1 Q
	S MDREQ=$P(MDX,"|",16) I 'MDREQ S MDFLG=1 Q
	S MDINST=$O(^MDD(702,"ACON",MDCON,0)) Q:'MDINST
	Q:$G(^MDD(702,+MDINST,0))=""
	I "5"[$P(^MDD(702,+MDINST,0),U,9) S MDCANR=$$CANCEL^MDHL7B(+MDINST)
	N MDFDA S MDFDA(702,+MDINST_",",.09)=6,MDCANC=1
	D FILE^DIE("K","MDFDA") K MDFDA
	N MDHEMO S MDHEMO=+$$GET1^DIQ(702,+MDINST,".04:.06","I")
	Q:MDHEMO<2
	Q:$G(^MDK(704.202,+MDINST,0))=""
	S MDFDA(704.202,+MDINST_",",.09)=0
	D FILE^DIE("","MDFDA")
	K ^MDK(704.202,"AS",1,+MDINST)
	S ^MDK(704.202,"AS",0,+MDINST)=""
	Q
RESUBM	; Resubmit a cancelled order
	N MDERR,MDHL7,MDHOLD,MDMAXD,MDNOW,MDSCHD,MDVSTD,MDXY
	Q:$P(MDX,"|",2)'="XX"
	K MDR S MDIFN=+$P(MDX,"|",3),MDCON=+$P(MDX,"|",4)
	I 'MDIFN S MDFLG=1 Q
	I 'MDCON S MDFLG=1 Q
	S MDPROV=+$P(MDX,"|",11) I 'MDPROV S MDFLG=1 Q
	S MDREQ=$P(MDX,"|",16) S:MDREQ MDREQ=$$FMDTE^MDWOR(MDREQ) I 'MDREQ S MDFLG=1 Q
	S MDINST=$O(^MDD(702,"ACON",MDCON,0)) Q:'MDINST
	S MDVSTD=$P($G(^MDD(702,MDINST,0)),"^",7)
	S MDSCHD=$S($L(MDVSTD,";")=1:MDVSTD,1:$P(MDVSTD,";",2)),MDMAXD=DT+.24
	Q:$$GET1^DIQ(702,MDINST_",",.09,"I")'=6
	N MDFDA,MDIENS,MDERR
	S MDFDA(702,MDINST_",",.07)=MDVSTD
	S MDFDA(702,MDINST_",",.09)=$S(MDSCHD>MDMAXD:0,1:5)
	D FILE^DIE("K","MDFDA") S MDHOLD="" K MDFDA
	Q:MDSCHD>MDMAXD
	S MDXY=$P(^MDD(702,MDINST,0),"^",4)
	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)
	S MDIENS=MDINST_",",MDHL7=$$SUB^MDHL7B(+MDIENS)
	I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
	I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
	D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR") K MDFDA,MDERR
	N MDHEMO S MDHEMO=+$$GET1^DIQ(702,+MDIENS,".04:.06","I")
	Q:MDHEMO<2
	S:$G(MDHOLD)'="" $P(^MDD(702,MDINST,0),"^",7)=MDHOLD
	Q:$G(^MDK(704.202,+MDINST,0))=""
	S MDFDA(704.202,+MDINST_",",.09)=1
	D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR") K MDFDA,MDERR
	K ^MDK(704.202,"AS",0,+MDINST)
	S ^MDK(704.202,"AS",1,+MDINST)=""
	Q