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

MDWOR   ; HOIFO/NCA - Main Routine to Decode HL7 ;5/23/07  10:49
        ;;1.0;CLINICAL PROCEDURES;**14**;Apr 01,2004;Build 20
        ; Reference IA# 2263 [Supported] XPAR calls
        ;               3071 [Subscription] Call $$PKGID^ORX8.
        ;               3468 [Subscription] Call GMRCCP.
        ;               10035 [Supported] Access Patient file DPT
        ;               10040 [Supported] Hospital Location File SC
        ;               10103 [Supported] XLFDT calls
        ;
EN(MDMSG)       ; Entry Point for CPRS and pass MSG in MDMSG
        N DFN,MDCON,MDCPROC,MDCANC,MDCANR,MDIFN,MDINST,MDINT,MDFLG,MDL,MDIN,MDINP,MDINST,MDLOC,MDNAM,MDOBC,MDOBX,MDOPRO,MDPROC,MDPAT
        N MDPROV,MDREQ,MDQTIM,MDSINP,MDVSTD,MDX S MDVSTD=""
        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
        .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)="OBR" D OBR Q
        .I $E(MDX,1,3)="OBX" D:MDOBC<1 OBX Q
        .Q
        I 'MDFLG,'MDCANC S MDATA="+1,^"_MDPROC_"^"_+MDCON_"^"_MDINST_"^"_MDVSTD D CHKIN(MDFN,MDREQ,MDPROV,MDATA,MDVSTD)
        Q
MSH     ; Decode MSH
        I $P(MDX,"|",2)'="^~\&" S MDFLG=1 Q
        I $P(MDX,"|",3)'="ORDER ENTRY" 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
        I MDPAT="I" S MDINP=1
        S MDLOC=+$P(MDX,"|",4) I $G(^SC(MDLOC,0))="" S MDFLG=1 Q
        S:MDINP>0 MDLOC=""
        Q
ORC     ; Check ORC
        I $P(MDX,"|",2)="NW" D NEW Q
        I $P(MDX,"|",2)="DC" D CANCEL Q
        S MDFLG=1
        Q
OBX     ; Check OBX
        N %,ANSWER,MDCV,MDOBX
        S MDOBX=$P(MDX,"|",6)
        I '+$$GET^XPAR("SYS","MD USE APPT WITH PROCEDURE",1) S MDOBC=MDOBC+1 Q
        S MDVSTD=$P(MDOBX,"Visit Date: ",2)
        S MDCV=$P(MDVSTD," ",1,2)
        I MDCV=""!(MDCV["UNKNOWN") S MDFLG=1 Q
        S MDVSTD=$P(MDCV," ")_"@"_$P(MDCV," ",2)
        D DT^DILF("T",MDVSTD,.ANSWER)
        S:ANSWER<0 ANSWER=""
        S MDVSTD=ANSWER I MDVSTD="" S MDFLG=1 Q
        I +MDLOC>0 S MDVSTD="A;"_MDVSTD_";"_MDLOC
        E  D NOW^%DTC S MDVSTD=%
        S MDOBC=MDOBC+1
        Q
NEW     ; New Order Segment
        S MDIFN=+$P(MDX,"|",3) I 'MDIFN S MDFLG=1 Q
        S MDPROV=+$P(MDX,"|",11) I 'MDPROV S MDFLG=1 Q
        S MDQTIM=$P(MDX,"|",8),MDQTIM=$P(MDQTIM,"^",6)
        S MDREQ=$P(MDX,"|",16) S MDREQ=$$FMDTE(MDREQ) I 'MDREQ S MDFLG=1 Q
        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)
        ; Retrieve Consult Number
        N MDFDA
        S MDCON=$$PKGID^ORX8(MDIFN) I 'MDCON S MDFLG=1 Q
        Q
OBR     ; Check OBR
        S MDPROC=$P(MDX,"|",5)
        I $E($P(MDPROC,"^",6),3,5)'["PRC" S MDFLG=1 Q
        S MDCPROC=$P(MDPROC,"^",4) I 'MDCPROC S MDFLG=1 Q
        ; Get Procedure for CP IEN
        S MDPROC=$$CPROC^GMRCCP(MDCPROC) I 'MDPROC S MDFLG=1 Q
        S MDSINP=$$HIGHV(MDPROC) I '+MDSINP S MDFLG=1 Q
        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
        .I +$$GET1^DIQ(702.09,+MDINT,".13","I") S MDINST=MDINT Q
        I +$P(MDSINP,"^",2)=2 D  Q
        .I +MDINP S MDVSTD="",MDOBC=MDOBC+1 Q
        .S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
        I +$P(MDSINP,"^",2)=3 D  Q
        .I +MDINP S MDVSTD="",MDOBC=MDOBC+1 Q
        I +$P(MDSINP,"^",2)=1 D  Q
        .I '+MDINP S MDVSTD="" Q
        .S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
        I +MDINP&('$P(^MDS(702.01,MDPROC,0),"^",5)) S MDFLG=1 Q
        I +MDINP S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
        S MDVSTD=MDREQ,MDOBC=MDOBC+1 Q
        Q
CANCEL  ; Cancel/Discontinue
        K MDR S MDIFN=+$P(MDX,"|",3),MDCON=+$P(MDX,"|",4),MDCANC=1
        I 'MDIFN S MDFLG=1 Q
        I 'MDCON S MDFLG=1 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
        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
CHKIN(MDFN,MDREQ,MDPROV,MDATA,MDVSTD)   ; [Procedure] Check In Study
        N MDX1,MDFDA,MDIEN,MDIENS,MDERR,MDHL7,MDHOLD,MDSCHD,MDMAXD,MDXY,MDNOW
        F MDX1=2:1:5 D
        .I $P(MDATA,U,MDX1)]"" S MDFDA(702,$P(MDATA,U,1),$P("^.04^.05^.11^.07",U,MDX1))=$P(MDATA,U,MDX1)
        ; Remove code after instrument testing available
        ; End of code removal after instrument available for testin
        S MDSCHD=$S($L(MDVSTD,";")=1:MDVSTD,1:$P(MDVSTD,";",2)),MDMAXD=DT+.24
        S MDFDA(702,$P(MDATA,U,1),.09)=$S(MDSCHD="":0,MDSCHD>MDMAXD:0,1:5)  ; Status = Checked-In
        I $P(MDATA,U,1)="+1," D
        .S MDFDA(702,"+1,",.01)=MDFN
        .S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
        .S MDFDA(702,"+1,",.03)=MDPROV
        .S:+MDSCHD MDFDA(702,"+1,",.14)=MDSCHD
        .D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR)
        .Q:MDSCHD>MDMAXD!(MDSCHD="")
        .S MDIENS=MDIEN(1)_",",MDXY=+$P(MDATA,U,2),MDHOLD="" I +MDXY D
        ..Q:$P(^MDS(702.01,MDXY,0),U,6)'=2
        ..S MDHOLD=$P($G(^MDD(702,MDIEN(1),0)),"^",7),MDNOW=$$NOW^XLFDT()
        ..S $P(^MDD(702,MDIEN(1),0),"^",7)=$S(MDNOW>MDSCHD:MDSCHD,1:MDNOW)
        .S MDHL7=$$SUB^MDHL7B(MDIEN(1))
        .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")
        Q:MDSCHD>MDMAXD!(MDSCHD="")
        D:+$G(MDIENS)
        .S MDXY=+$P(MDATA,U,2) Q:'MDXY
        .I $P(^MDS(702.01,MDXY,0),U,6)=2 D  Q  ; Renal Check-In
        ..D CP^MDKUTL(+MDIENS)
        ..S:$G(MDHOLD)'="" MDFDA(702,+MDIENS_",",.07)=MDHOLD
        ..S MDFDA(702,+MDIENS_",",.09)=5
        ..D FILE^DIE("","MDFDA","MDERR")
        Q
FMDTE(DATE)     ; Convert HL-7 formatted date to a Fileman formatted date
        N X
        S X="" I DATE D
        .S X=$$HL7TFM^XLFDT(DATE,"L")
        Q X
HIGHV(MDHV)     ; Return flag indicator whether procedure is use for auto check-in
        N MDANS,MDK,MDKY,MDLST S MDANS=0
        D GETLST^XPAR(.MDLST,"SYS","MD CHECK-IN PROCEDURE LIST")
        F MDK=0:0 S MDK=$O(MDLST(MDK)) Q:MDK<1  S MDKY=$G(MDLST(MDK)) D
        .I MDHV=+$P(MDKY,"^") S MDANS=MDKY
        Q MDANS