Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDHL7U3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_PROCEDURES-MD/MDHL7U3.m
r613 r623 1 MDHL7U3 ; HOIFO/WAA -Utilities for CP to process HL7 messages ; 7/26/00 2 ;;1.0;CLINICAL PROCEDURES;**6**;Apr 01, 2004;Build 102 3 ; Reference DBIA #2729 [Supported] for XMXPAI 4 ; Reference DBIA #4262 [Supported] for HL7 call. 5 ; Reference DBIA #3273 [Subscription] for HL7 call. 6 ; Reference DBIA #10138 [Supported] for HL7 call. 7 ; Reference DBIA #3990 [Supported] for ICDCODE call 8 ; Reference DBIA #1131 [Supported] for XMB("NETNAME") reference 9 ; Reference DBIA #1995 [Supported] for ICPTCOD to handle CPT Codes call 10 ; Reference DBIA #10082 [Supported] for ^ICD9 reference 11 ; Reference DBIA #10111 [Supported] for FILE 3.8 call 12 ; Reference DBIA #10103 [Supported] for XLFDT call 13 ; 14 HL7CHK(MDD702) ; Check to see of there is an entry in 703.1 for a patient. 15 N X 16 S X="1^" 17 D 18 . N Y 19 . I $G(^MDD(702,MDD702,0))="" S X="-1^No Entry in 702." Q 20 . I $D(^MDD(703.1,"ASTUDYID",MDD702))=0 Q 21 . S Y=0 22 . S Y=$O(^MDD(703.1,"ASTUDYID",MDD702,Y)) I Y>0 S X="-1^This Study has Data on file." 23 . Q 24 Q X 25 XVERT(MDA,MDB) ; Strip out blank Lines 26 Q:MDA="" 27 Q:MDB="" 28 Q:$G(^TMP($J,MDA,1)) 29 N I,CNT,CNT2,NODE,FLG 30 S (CNT,I,FLG)=0 31 F S I=$O(^TMP($J,MDA,I)) Q:I<1 D 32 . S NODE=$TR(^TMP($J,MDA,I),$C(10),"") 33 . I NODE="" S FLG=0 Q 34 . I FLG D Q 35 . . S CNT2=CNT2+1 36 . . S ^TMP($J,MDB,CNT,CNT2)=NODE 37 . . Q 38 . I 'FLG D Q 39 . . S CNT=CNT+1 40 . . S ^TMP($J,MDB,CNT)=NODE 41 . . S FLG=1,CNT2=0 42 . . Q 43 . Q 44 Q 45 ; 46 PURGE(MDD7031) ; 47 ; This sub-routine will delete HL7 772 Message text after a message 48 ; been processed by Imaging. 49 Q:'$D(^MDD(703.1,MDD7031,0)) ; No entry found 50 S MDD772=$P(^MDD(703.1,MDD7031,0),U,6) Q:MDD772="" 51 D DELBODY^HLUOPT2(MDD772,"CLINICAL PROCEDURES message purge","^TMP($J,""IN"")") 52 S $P(^MDD(703.1,MDD7031,0),U,6)="" 53 Q 54 ; 55 PHY(X,MDIEN) ; Add the doc who did the exam to the report 56 Q 57 ; This will be implemented with the Doctor Lookup when it comes out. 58 N LINE1,LINE 59 S LINE1=$P(X,"|",17) 60 S LINE=$P(LINE1,"^",2) ; Last 61 S LINE=LINE_$S($P(LINE1,"^",3)'="":", "_$P(LINE1,"^",3),1:"") ; First 62 S LINE=LINE_$S($P(LINE1,"^",4)'="":" "_$P(LINE1,"^",4),1:"") ; MI 63 D ADD(MDIEN,"9",LINE) 64 Q 65 ; 66 CPTICD(X,MDIEN) ; Break out CPT and ICD9 codes 67 N ICD,CPT 68 Q:MDIEN<1 69 S CPT=$P(X,"|",45) I CPT'="" D FILECD(MDIEN,CPT,"7") 70 S ICD=$P(X,"|",14) I ICD'="" D FILECD(MDIEN,ICD,"8") 71 Q 72 FILECD(MDIEN,CODE,TYPE) ; fILE THE DATA 73 N LINE,Y,I,CNT,RESULT 74 S CNT=$L(CODE,"~") 75 S LINE="" 76 F I=1:1:CNT S Y=$P(CODE,"~",I),RESULT=$P(Y,"^",1),LINE(.2,I,0)=RESULT 77 S LINE(.2,0)="^^"_CNT_"^"_CNT_"^"_$P(%,".") 78 Q:CNT<1 ; file the results if there is any 79 D ADD(MDIEN,TYPE,.LINE,CNT) 80 Q 81 ; 82 ADD(MDIEN,TYPE,LINE,CNT) ; 83 ; Create an entry in the .1 node 84 N NODE,X 85 S NODE=$G(^MDD(703.1,MDIEN,.1,0)) Q:NODE="" 86 S NODE=$P(NODE,"^",3) 87 S NODE=NODE+1 88 S $P(^MDD(703.1,MDIEN,.1,0),"^",3,4)=NODE_"^"_NODE 89 S $P(^MDD(703.1,MDIEN,.1,NODE,0),"^")=TYPE 90 D NOW^%DTC 91 M ^MDD(703.1,MDIEN,.1,NODE)=LINE 92 Q 93 ; 94 MSGIEN(MDHLIENS,MDHLREST) ; Return the message as definded in MDHLIENS to the array in MDHLREST 95 ; Only TCP type messages 96 ; input: MDHLIENS= the intern entry number of the message in ^HLMA 97 ; MDHLREST = the return array that will contain the whole HL7 message 98 ; output: return "1^Message complete" if message was successful, "0^reason" if failed. 99 ; 100 N MDHLIEN,MDHLI,MDHLCNT,MDHLZ,RET 101 S (MDHLCNT,MDHLI,RET)=0 102 I $G(MDHLIENS)="" S RET=RET_"^No IEN defined" Q RET ; Exit because no IEN for ^HLMA was provided 103 I $G(MDHLREST)="" S RET=RET_"^No Return ARRAY provided" Q RET ; Exit because no return array was provided 104 I $G(^HLMA(MDHLIENS,0))="" S RET=RET_"^HLMA entry does not exist" Q RET ; Exit because invalid OR non-EXISTING HLMA ENTRY 105 S MDHLIEN=$P(^HLMA(MDHLIENS,0),U) 106 I MDHLIEN="" S RET=RET_"^No pointer value to file 772" Q RET ; No Pointer to 772 107 I $G(^HL(772,MDHLIEN,0))="" S RET=RET_"^772 Entry does not exist" Q RET ; No 772 entry exist 108 ;get header 109 S MDHLZ=$G(^HLMA(MDHLIENS,"MSH",1,0)) 110 I MDHLZ="" S RET=RET_"^No MSH segment found" Q RET ; No MSH was found 111 S MDHLCNT=MDHLCNT+1,@MDHLREST@(MDHLCNT)=MDHLZ 112 S MDHLCNT=MDHLCNT+1,@MDHLREST@(MDHLCNT)="" 113 ;get body 114 S MDHLI=0 115 F S MDHLI=$O(^HL(772,MDHLIEN,"IN",MDHLI)) Q:'MDHLI D 116 . S MDHLCNT=MDHLCNT+1 117 . S @MDHLREST@(MDHLCNT)=$G(^HL(772,MDHLIEN,"IN",MDHLI,0)) 118 . Q 119 I MDHLCNT'>2 S RET=RET_"^No message body found" Q RET ; There was no body 120 S RET="1^Message complete" 121 Q RET 122 ; 123 CICNV(MDIEN,RETURN) ; This subroutine will read the data in 703.1 and return the results 124 ;in the indicated global 125 N NODE,FLG 126 S FLG=1 127 Q:MDIEN="" ; The ien was null 128 Q:RETURN="" ; the array was null 129 S ARRAY(0)="0^0" 130 I $G(^MDD(703.1,MDIEN,.1,0))="" S FLG=0 Q ; There is not data. 131 ; Start the processing of ICD/POV codes Value is 8 132 S NODE=0 133 I FLG I $G(^MDD(703.1,MDIEN,.1,0))'="" D 134 . F S NODE=$O(^MDD(703.1,MDIEN,.1,NODE)) Q:NODE<1 D 135 . . S TYPE=$P($G(^MDD(703.1,MDIEN,.1,NODE,0),0),"^",1) 136 . . I TYPE=8 D PROCESS(MDIEN,NODE,TYPE,.ARRAY) 137 . . I TYPE=7 D PROCESS(MDIEN,NODE,TYPE,.ARRAY) 138 . . Q 139 . Q 140 M @RETURN=ARRAY 141 Q 142 PROCESS(MDIEN,NODE,TYPE,ARRAY) ; This will process the data for each 143 N CNT,X,CONT,CODE,AR,TP,LOC 144 S CNT=0,CONT=0 145 F S CNT=$O(^MDD(703.1,MDIEN,.1,NODE,.2,CNT)) Q:CNT<1 D 146 . S CODE=$G(^MDD(703.1,MDIEN,.1,NODE,.2,CNT,0),"") ; Grabbing the ICD9 AND CPT codes 147 . I CODE="" Q 148 . I TYPE=8 S AR=1,TP="POV",X=$$ICDDX^ICDCODE(CODE) Q:X="" ; Reference DBIA #3990 [Supported] for ICDCODE call 149 . I TYPE=7 S AR=2,TP="CPT",X=$$CPT^ICPTCOD(CODE) Q:X="" ; Reference DBIA #1995 [Supported] for ICPTCOD to handle CPT Codes call 150 . S CONT=CONT+1 151 . S ARRAY(AR)=CONT_"^"_CONT 152 . I AR=1 D 153 . . N DESC,IN,LN 154 . . S IN=$P(X,"^",1) Q:IN<1 155 . . S LN=$G(^ICD9(IN,0),0) Q:LN="" 156 . . S DESC=$P(LN,"^",3) Q:DESC="" 157 . . S I=CONT 158 . . S $P(ARRAY(AR,I),"^",1)=TP 159 . . S $P(ARRAY(AR,I),"^",2)=$P(X,"^",1) 160 . . S $P(ARRAY(AR,I),"^",3)=$P(X,"^",2) 161 . . S $P(ARRAY(AR,I),"^",5)=DESC 162 . . S $P(ARRAY(AR,I),"^",6)=$S(I=1:1,1:0) 163 . . Q 164 . I AR=2 D 165 . . N DESC,IN,LN 166 . . S IN=$P(X,"^",1) Q:IN<1 167 . . ; S LN=$G(^ICPT(IN,0),0) Q:LN="" 168 . . S DESC=$P(X,"^",3) Q:DESC="" ; DBIA1995 $$CPT^ICPTCOD(CODE) returns X and the second piece of X is the DESC 169 . . S I=CNT 170 . . S $P(ARRAY(AR,I),"^",1)=TP 171 . . S $P(ARRAY(AR,I),"^",2)=$P(X,"^",1) 172 . . S $P(ARRAY(AR,I),"^",3)=$P(X,"^",2) 173 . . S $P(ARRAY(AR,I),"^",5)=DESC 174 . . S $P(ARRAY(AR,I),"^",7)=$S(I=1:1,1:0) 175 . . Q 176 . Q 177 I $D(ARRAY(1))!$D(ARRAY(2)) S ARRAY(0)="1^1" 178 Q 179 ; 180 NOTICE(SUBJECT,TXT,DEVIEN,DUZ) ; This will fire off a mail message to the Indicated mail group saying that a study was deleted 181 ; 182 N INST,MG,XMTO,XMDUZ,XMSUBJ,XMBODY,N,X 183 S MG=0 184 S INST=DEVIEN 185 I INST>1 S MG=$P($G(^MDS(702.09,INST,0)),"^",2) 186 I 'MG!('$$MG^MDHL7U2(MG)) S MG=$$FIND1^DIC(3.8,"","BX","MD DEVICE ERRORS") Q:'MG 187 S MG=$$GET1^DIQ(3.8,+MG_",",.01) 188 S XMTO="G."_MG_"@"_^XMB("NETNAME"),XMINSTR("FROM")=.5 189 S XMBODY="TXT" 190 S XMSUBJ=SUBJECT 191 D SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,XMTO,.XMINSTR) 192 Q 193 ; 194 ALERT(MDSIEN) ; This is to send an e-mail to the main device mail group that a study has been deleted 195 D NOW^%DTC 196 S SUBJECT="Study "_MDSIEN_" for Patient "_$$GET1^DIQ(702,MDSIEN,.01,"E")_" has been DELETED!" 197 S BODY(1)="The following study has been deleted." 198 S BODY(2)=" By the USER: "_$$GET1^DIQ(200,DUZ,.01,"E") 199 S BODY(3)=" On Date: "_$$FMTE^XLFDT(%,1) 200 S BODY(4)=" " 201 S BODY(5)=" CP Study Information" 202 S BODY(6)="------------------------------------------------------------------------------ " 203 S BODY(7)="CP Study ID: "_MDSIEN 204 S BODY(8)="CP Study Def: "_$$GET1^DIQ(702,MDSIEN,.04,"E") 205 S BODY(9)="Created on: "_$$FMTE^XLFDT($$GET1^DIQ(702,MDSIEN,.02,"I"),1) 206 S BODY(10)="Created by: "_$$GET1^DIQ(702,MDSIEN,.03,"E") 207 S BODY(11)="On Instrument: "_$$GET1^DIQ(702,MDSIEN,.11,"E") 208 S BODY(12)="For Patient: "_$$GET1^DIQ(702,MDSIEN,.01,"E") 209 S BODY(13)=" SSN: "_$E($$GET1^DIQ(702,MDSIEN,.011,"E"),6,9) 210 S BODY(14)=" DOB: "_$$FMTE^XLFDT($$GET1^DIQ(702,MDSIEN,.012,"I"),1) 211 S DEVIEN=$$GET1^DIQ(702,MDSIEN,.11,"I") 212 Q 1 MDHL7U3 ; HOIFO/WAA -Utilities for CP to process HL7 messages ; 7/26/00 2 ;;1.0;CLINICAL PROCEDURES;;Apr 01, 2004 3 ; Reference DBIA #4262 [Supported] for HL7 call. 4 ; 5 PURGE(MDD7031) ; 6 ; This sub-routine will delete HL7 772 Message text after a message 7 ; been processed by Imaging. 8 Q:'$D(^MDD(703.1,MDD7031,0)) ; No entry found 9 S MDD772=$P(^MDD(703.1,MDD7031,0),U,6) Q:MDD772="" 10 D DELBODY^HLUOPT2(MDD772,"CLINICAL PROCEDURES message purge","^TMP($J,""IN"")") 11 S $P(^MDD(703.1,MDD7031,0),U,6)="" 12 Q
Note:
See TracChangeset
for help on using the changeset viewer.
