[628] | 1 | MDHL7A ; HOIFO/WAA - Routine to Decode HL7 for CP ;9/17/07 08:17
|
---|
| 2 | ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102
|
---|
| 3 | ; Reference DBIA #10035 [Supported] for DPT calls.
|
---|
| 4 | ; Reference DBIA #10106 [Supported] for HLFNC calls.
|
---|
| 5 | ; Reference DBIA #10062 [Supported] for VADPT6 calls.
|
---|
| 6 | ; Reference DBIA #2701 [Supported] for MPIF001 calls
|
---|
| 7 | ; Reference DBIA #10096 [Supported] for ^%ZOSF calls
|
---|
| 8 | EN ; [Procedure] Entry Point for Message Array in MSG
|
---|
| 9 | N %,BID,CODE,CPT,DA,DATE,DFN,DIK,DLCO,DTO,DZ,ERRTX,EXAM,EXE,MDFLAG,FIL
|
---|
| 10 | N I,ICNT,ID,IMP,J,K,LBL,LINO,LINE,LN,MDAPP,MDRTN,MG,MSG,N,NAM,NEXT,NUM
|
---|
| 11 | N ORIFN,P,PID,PIEN,S,SEG,SET,SEP,MDSSN,STR,STYP,SUB,TCNT,TXT,UNIQ,SEC
|
---|
| 12 | N UNITS,VA,VAL,X,XMBODY,XMDUZ,XMSUBJ,XMTO,Z,ZZ,Z1,Z2,MDERROR
|
---|
| 13 | N ECODE,MDIEN,MDOBX,NUMZ,PNAM,ZCODE,MDDEV,MDD702,DEVNAME,DEVIEN,MDQFLG
|
---|
| 14 | N MDIORD
|
---|
| 15 | K ^TMP($J,"MDHL7A"),^TMP($J,"MDHL7"),^TMP($J,"MDHL7A1")
|
---|
| 16 | S MDFLAG=0,MDERROR=0,MDQFLG=0
|
---|
| 17 | Q:$G(HLMTIENS)=""
|
---|
| 18 | S ^TMP($J,"MDHL7A1")=""
|
---|
| 19 | S HLREST="^TMP($J,""MDHL7A1"")"
|
---|
| 20 | S X=$$MSGIEN^MDHL7U3(HLMTIENS,HLREST) ; This code is to convert the HL7 Message **6**
|
---|
| 21 | I $P(X,U)=0 D Q
|
---|
| 22 | . S DEVIEN=0,ECODE=0
|
---|
| 23 | . S ERRTX=$P(X,U,2)
|
---|
| 24 | . D ^MDHL7X
|
---|
| 25 | . Q
|
---|
| 26 | I $P(X,U)=1 D XVERT^MDHL7U3("MDHL7A1","MDHL7A")
|
---|
| 27 | K HLNODE,^TMP($J,"MDHL7A1")
|
---|
| 28 | ;
|
---|
| 29 | EN2 ; [Procedure] No Description
|
---|
| 30 | S (DEVIEN,DEVNAME)="",I=0
|
---|
| 31 | F I=1:1 S X=$G(^TMP($J,"MDHL7A",I)) Q:X="" Q:$E(X,1,3)="OBX" D
|
---|
| 32 | . S:$E(X,1,3)="MSH" DEVNAME=$P(X,"|",4)
|
---|
| 33 | . I DEVNAME="",HLREC("SFN")'="" S DEVNAME=HLREC("SFN")
|
---|
| 34 | . I $E(X,1,3)="MSH",DEVNAME'="Instrument Manager" S DEVIEN=$O(^MDS(702.09,"B",DEVNAME,0))
|
---|
| 35 | . I $E(X,1,3)="OBR" D
|
---|
| 36 | .. I DEVNAME="Instrument Manager" D
|
---|
| 37 | ... S DEVNAME=$P(X,"|",25)
|
---|
| 38 | ... Q
|
---|
| 39 | .. S MDIORD=$P(X,"|",4)
|
---|
| 40 | .. S MDD702=$S(+MDIORD<1:"",1:$$GETSTDY^MDRPCOT1(MDIORD))
|
---|
| 41 | .. I MDD702<1 S MDD702="" Q
|
---|
| 42 | .. I MDD702>0 D ;Validate the entry from 702 is good.
|
---|
| 43 | ... I $G(^MDD(702,MDD702,0))="" S MDD702="" Q
|
---|
| 44 | ... S DEVIEN=$$GET1^DIQ(702,MDD702,.11,"I")
|
---|
| 45 | ... I DEVIEN<1 S DEVIEN="" ; No device defined
|
---|
| 46 | ... Q
|
---|
| 47 | .. Q
|
---|
| 48 | . Q
|
---|
| 49 | I DEVIEN="",DEVNAME'="" S DEVIEN=$O(^MDS(702.09,"B",DEVNAME,0))
|
---|
| 50 | I DEVNAME="" S ERRTX="Invalid device Code" D ^MDHL7X Q
|
---|
| 51 | I DEVIEN="" S ERRTX="Invalid device entry" D ^MDHL7X Q
|
---|
| 52 | S ZCODE=$P($G(^MDS(702.09,DEVIEN,.1)),"^",2)
|
---|
| 53 | S ECODE=0,INST=DEVIEN,MDAPP=DEVNAME
|
---|
| 54 | I 'INST S ERRTX="Invalid Application Code" D ^MDHL7X Q
|
---|
| 55 | D INST^MDHL7U2(DEVIEN,.ECODE) I 'ECODE D Q
|
---|
| 56 | . S ERRTX="Device Error" D ^MDHL7X
|
---|
| 57 | . Q
|
---|
| 58 | I (ZCODE="M")!(ZCODE="B") D Q:MDERROR Q:ZCODE="M" ;
|
---|
| 59 | . S MDFLAG=1,MDERROR=0 ; Tell Medicine that CP is talking to HL7
|
---|
| 60 | . D ^MDHL7MCA ; Run the Medicine routines
|
---|
| 61 | . Q:MDERROR ; Medicine found an error and sent an error back
|
---|
| 62 | . Q
|
---|
| 63 | S NUMZ=$O(^TMP($J,"MDHL7A",""),-1)
|
---|
| 64 | S NUM=0,MDOBX=0
|
---|
| 65 | F NUM=1:1:NUMZ D Q:$G(ERRTX)'=""
|
---|
| 66 | . S LINO=^TMP($J,"MDHL7A",NUM)
|
---|
| 67 | . S SEC=$P(LINO,"|")
|
---|
| 68 | . I SEC="MSH" D MSH Q
|
---|
| 69 | . I SEC="PID" D PID Q
|
---|
| 70 | . I SEC="OBR" D OBR Q
|
---|
| 71 | . I SEC="PV1" Q
|
---|
| 72 | . I SEC="ORC" Q
|
---|
| 73 | . I SEC="OBX" S MDOBX=1 Q
|
---|
| 74 | . Q
|
---|
| 75 | Q:$G(ERRTX)'=""
|
---|
| 76 | I 'MDOBX S ERRTX="OBX not found when expected" D ^MDHL7X Q
|
---|
| 77 | D OBX
|
---|
| 78 | D STATUS(MDIEN,"P")
|
---|
| 79 | K ^TMP($J,"MDHL7A"),^TMP($J,"MDHL7")
|
---|
| 80 | Q
|
---|
| 81 | STATUS(DA,STAT) ; Update the status of the report in 703.1
|
---|
| 82 | Q:$G(ERRTX)'=""
|
---|
| 83 | S $P(^MDD(703.1,DA,0),U,9)=STAT
|
---|
| 84 | S DIK="^MDD(703.1," D IX1^DIK
|
---|
| 85 | Q
|
---|
| 86 | IM ;Instrument Manager Interface
|
---|
| 87 | Q:DEVNAME'="Instrument Manager"
|
---|
| 88 | I $E(X,1,3)'="OBR" Q
|
---|
| 89 | S DEVNAME=$P(X,"|",25)
|
---|
| 90 | S DEVIEN=$O(^MDS(702.09,"B",DEVNAME,0))
|
---|
| 91 | Q
|
---|
| 92 | ;
|
---|
| 93 | MSH ; [Procedure] Decode MSH
|
---|
| 94 | N SEG
|
---|
| 95 | I '$D(^TMP($J,"MDHL7A",NUM)) Q
|
---|
| 96 | S X=$G(^TMP($J,"MDHL7A",NUM)),SEG("MSH")=X
|
---|
| 97 | I $E(X,1,3)'="MSH" S ERRTX="MSH not first record" D ^MDHL7X Q
|
---|
| 98 | Q
|
---|
| 99 | ;
|
---|
| 100 | OBR ; [Procedure] Check OBR
|
---|
| 101 | N MDGMRC
|
---|
| 102 | S X=$G(^TMP($J,"MDHL7A",NUM)) I $E(X,1,3)'="OBR" S ERRTX="OBR not found when expected" D ^MDHL7X Q
|
---|
| 103 | S SEG("OBR")=X
|
---|
| 104 | S MDIORD=$P(X,"|",4)
|
---|
| 105 | S MDD702=$S(+MDIORD<1:"",1:$$GETSTDY^MDRPCOT1(MDIORD))
|
---|
| 106 | ;I MDD702'="" S MDD702=$$CHK^MDNCHK(MDD702) ; PATCH 11
|
---|
| 107 | S ORIFN=$P(X,"|",3),(EXAM,%)=$P(X,"|",5) I EXAM'="" S EXAM=$P(%,"^",2) I EXAM="" S EXAM=$P(%,"^",1)
|
---|
| 108 | S CPT=$P(X,"|",5) I $P(CPT,"^",3)["CPT" S CPT=$P(CPT,"^",1)
|
---|
| 109 | S DTO="",DATE=$P(X,"|",8) I DATE'="" S:$L(DATE)>14 DATE=$E(DATE,1,14) S DTO=$$FMDATE^HLFNC(DATE)
|
---|
| 110 | ; vvv== Added to address the issues of mismatch
|
---|
| 111 | I $G(MDD702)>0 I DFN'=$$GET1^DIQ(702,MDD702,.01,"I") S ERRTX="Patient name Mismatch. Name in PID doesn't match the name in the CP Order #"_MDD702_"." D ^MDHL7X Q
|
---|
| 112 | I $G(MDD702)>0 I MDDOB'=$$GET1^DIQ(2,DFN,.03,"I") S ERRTX="Patient DOB Mismatch. DOB in PID doesn't match the DOB in the CP Order #"_MDD702_"." D ^MDHL7X Q
|
---|
| 113 | I DTO="" S ERRTX="Missing required Date/Time of Procedure in OBR" D ^MDHL7X Q
|
---|
| 114 | ;;S UNIQ=$TR($H,",","-")
|
---|
| 115 | S UNIQ=$$NEWID(DFN,DATE,INST,$G(MDD702),HLMTIEN)
|
---|
| 116 | I +UNIQ="-1" S ERRTX="Unable to Create or Lock 703.1" D ^MDHL7X Q
|
---|
| 117 | S MDIEN=$P(UNIQ,"^",1) ; Got the IEN for 703.1
|
---|
| 118 | N SET S SET=DTO_"^"_$P(UNIQ,U,2),ICNT=0 N IMP
|
---|
| 119 | S MDRTN=$P($G(^MDS(702.09,INST,.1)),"^",1) S:MDRTN'["^" MDRTN="^"_MDRTN
|
---|
| 120 | S X=MDRTN S:X["^" X=$P(X,"^",2) X ^%ZOSF("TEST") I '$T S ERRTX="Processing routine not found" D ^MDHL7X Q ; IA %10096
|
---|
| 121 | D CPTICD^MDHL7U3(X,MDIEN) ; Update CPT and ICD9
|
---|
| 122 | D PHY^MDHL7U3(X,MDIEN) ; Get Doc who did the procedure.
|
---|
| 123 | Q
|
---|
| 124 | ;
|
---|
| 125 | PID ; [Procedure] Check PID
|
---|
| 126 | S X=$G(^TMP($J,"MDHL7A",NUM)) I $E(X,1,3)'="PID" S ERRTX="PID not second record" D ^MDHL7X Q
|
---|
| 127 | S SEG("PID")=X
|
---|
| 128 | S MDDOB=$P(X,"|",8) I MDDOB'="" S MDDOB=($E(MDDOB,1,4)-1700)_$E(MDDOB,5,8)
|
---|
| 129 | I $L($P(X,"|",4))'<16 D I +DFN=-1 Q
|
---|
| 130 | . N ICN
|
---|
| 131 | . S ICN=$P(X,"|",4)
|
---|
| 132 | . S DFN=$$GETDFN^MPIF001(ICN)
|
---|
| 133 | . I +DFN=-1 S ERRTX=$P(DFN,U,2)
|
---|
| 134 | . D MDSSN I DFN<1 S ERRTX="SSN not found" D ^MDHL7X Q
|
---|
| 135 | . I DFN>0 K ERRTX
|
---|
| 136 | . S MDSSN=$$GET1^DIQ(2,DFN,.09,"I") I MDSSN="" S MDSSN=" ",DFN=0
|
---|
| 137 | . Q
|
---|
| 138 | E D MDSSN
|
---|
| 139 | I 'DFN S ERRTX="SSN not found" D ^MDHL7X Q
|
---|
| 140 | S Z1=$P($G(^DPT(DFN,0)),",",1),Z2=$P(NAM,"^",1)
|
---|
| 141 | S Z1=$TR(Z1,"abcdefghijklmnopqrstuvwxyz- '","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|
| 142 | S Z2=$TR(Z2,"abcdefghijklmnopqrstuvwxyz- '","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
---|
| 143 | I $E(Z1,1,3)'=$E(Z2,1,3) S ERRTX="Last Name MisMatch" D ^MDHL7X Q
|
---|
| 144 | S PNAM=$TR(NAM,"^",",")
|
---|
| 145 | D PID^VADPT6 S PID=$G(VA("PID")),BID=$G(VA("BID")) N VA
|
---|
| 146 | Q
|
---|
| 147 | MDSSN ; This subroutine is to match up the SSN for a patient.
|
---|
| 148 | S NAM=$P(X,"|",6),MDSSN=$P(X,"|",20) I $L(MDSSN)<9 S MDSSN=$P(X,"|",4)
|
---|
| 149 | S MDSSN=$P(MDSSN,"^",1) I MDSSN'?9N S MDSSN=$TR(MDSSN,"- ","")
|
---|
| 150 | I $E(MDSSN,$L(MDSSN))="P" S MDSSN=$E(MDSSN,1,9)
|
---|
| 151 | S:MDSSN'?9N MDSSN=" " S DFN=$O(^DPT("SSN",MDSSN,0))
|
---|
| 152 | I 'DFN S DFN=$O(^DPT("SSN",MDSSN_"P",0))
|
---|
| 153 | Q
|
---|
| 154 | ;
|
---|
| 155 | OBX ; [Observation]
|
---|
| 156 | D @MDRTN
|
---|
| 157 | Q
|
---|
| 158 | NEWID(DFN,DATE,INST,MDD702,HLMTIEN) ; Generate a new entry and ID of 703.1
|
---|
| 159 | N NEWID,MDFDA,MDIEN,MDNO
|
---|
| 160 | S NEWID=$TR($H,",","-") ; Create inital ID
|
---|
| 161 | L +(^MDD(703.1,"B")):60 E Q "-1"
|
---|
| 162 | ;^^--- Unable to get a lock in the file
|
---|
| 163 | F Q:'$D(^MDD(703.1,"B",NEWID)) H 1 S NEWID=$TR($H,",","-")
|
---|
| 164 | ;^^--- Search to create a new ID if current ID is in use
|
---|
| 165 | S MDFDA(703.1,"+1,",.01)=NEWID
|
---|
| 166 | S MDFDA(703.1,"+1,",.02)=DFN
|
---|
| 167 | S MDFDA(703.1,"+1,",.03)=$$HL7TFM^MDHL7U(DATE)
|
---|
| 168 | S MDFDA(703.1,"+1,",.04)=INST
|
---|
| 169 | S MDFDA(703.1,"+1,",.05)=MDD702
|
---|
| 170 | S MDFDA(703.1,"+1,",.06)=HLMTIEN
|
---|
| 171 | D UPDATE^DIE("","MDFDA","MDIEN")
|
---|
| 172 | L -(^MDD(703.1,"B"))
|
---|
| 173 | I $G(MDIEN(1))>0 D Q MDIEN(1)_U_NEWID
|
---|
| 174 | . S ^MDD(703.1,MDIEN(1),.1,0)="^703.11S^0^0"
|
---|
| 175 | . S MDNO=$$NTIU^MDRPCW1(+MDD702)
|
---|
| 176 | . Q
|
---|
| 177 | ; ^^--- Create Subfile and quit
|
---|
| 178 | Q "-1" ; Unable to create file
|
---|
| 179 | ;
|
---|
| 180 | PROC ; [Procedure] Create report entry in file (703.1)
|
---|
| 181 | D PROC^MDHL7U
|
---|
| 182 | Q
|
---|