Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MDHL7U3

MDHL7U3.m

Go to the documentation of this file. 
  1. MDHL7U3 ;HOIFO/WAA - Utilities for CP to process HL7 messages ;02/17/10  15:59
  1.  ;;1.0;CLINICAL PROCEDURES;**6,21,29**;Apr 01, 2004;Build 22
  1.  ; Reference DBIA #2729 [Supported]  for XMXPAI
  1.  ; Reference DBIA #4262 [Supported] for HLUOPT2 call.
  1.  ; Reference DBIA #3244 [Subscription] for MSH node of HLMA file (#773).
  1.  ; Reference DBIA #3273 [Subscription] for reference HLMA of file (#773).
  1.  ; Reference DBIA #10138 [Supported] for reference of HL file (#772).
  1.  ; Reference DBIA #1131 [Supported] for XMB("NETNAME") reference
  1.  ; Reference DBIA #1995 [Supported] for ICPTCOD to handle CPT Codes call
  1.  ; Reference DBIA #10060 [Supported] NEW PERSON FILE (#200) Lookup.
  1.  ; Reference DBIA #10111 [Supported] for FILE 3.8 call
  1.  ; Reference DBIA #10103 [Supported] for XLFDT call
  1.  ;
  1. HL7CHK(MDD702) ; Check to see of there is an entry in 703.1 for a patient.
  1.  N X
  1.  S X="1^"
  1.  D
  1.  . N Y
  1.  . I $G(^MDD(702,MDD702,0))="" S X="-1^No Entry in 702." Q
  1.  . I $D(^MDD(703.1,"ASTUDYID",MDD702))=0 Q
  1.  . S Y=0
  1.  . S Y=$O(^MDD(703.1,"ASTUDYID",MDD702,Y)) I Y>0 S X="-1^This Study has Data on file."
  1.  . Q
  1.  Q X
  1. XVERT(MDA,MDB) ; Strip out blank Lines
  1.  Q:MDA=""
  1.  Q:MDB=""
  1.  Q:$G(^TMP($J,MDA,1))
  1.  N I,CNT,CNT2,NODE,FLG
  1.  S (CNT,I,FLG)=0
  1.  F  S I=$O(^TMP($J,MDA,I)) Q:I<1  D
  1.  . S NODE=$TR(^TMP($J,MDA,I),$C(10),"")
  1.  . I NODE=" " S NODE=""
  1.  . I NODE="" S FLG=0 Q
  1.  . I FLG  D  Q
  1.  . . S CNT2=CNT2+1
  1.  . . S ^TMP($J,MDB,CNT,CNT2)=NODE
  1.  . . Q
  1.  . I 'FLG D  Q
  1.  . . S CNT=CNT+1
  1.  . . S ^TMP($J,MDB,CNT)=NODE
  1.  . . S FLG=1,CNT2=0
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. PURGE(MDD7031) ;
  1.  ; This sub-routine will delete HL7 772 Message text after a message
  1.  ; been processed by Imaging.
  1.  Q:'$D(^MDD(703.1,MDD7031,0))  ; No entry found
  1.  S MDD772=$P(^MDD(703.1,MDD7031,0),U,6) Q:MDD772=""
  1.  D DELBODY^HLUOPT2(MDD772,"CLINICAL PROCEDURES message purge","^TMP($J,""IN"")")
  1.  S $P(^MDD(703.1,MDD7031,0),U,6)=""
  1.  Q
  1.  ;
  1. PHY(X,MDIEN) ; Add the doc who did the exam to the report
  1.  Q
  1.  ; This will be implemented with the Doctor Lookup when it comes out.
  1.  N LINE1,LINE
  1.  S LINE1=$P(X,"|",17)
  1.  S LINE=$P(LINE1,"^",2) ; Last
  1.  S LINE=LINE_$S($P(LINE1,"^",3)'="":", "_$P(LINE1,"^",3),1:"") ; First
  1.  S LINE=LINE_$S($P(LINE1,"^",4)'="":" "_$P(LINE1,"^",4),1:"") ; MI
  1.  D ADD(MDIEN,"9",LINE)
  1.  Q
  1.  ;
  1. CPTICD(X,MDIEN) ; Break out CPT and ICD9 codes
  1.  N ICD,CPT
  1.  Q:MDIEN<1
  1.  S CPT=$P(X,"|",45) I CPT'="" D FILECD(MDIEN,CPT,"7")
  1.  S ICD=$P(X,"|",14) I ICD'="" D FILECD(MDIEN,ICD,"8")
  1.  Q
  1. FILECD(MDIEN,CODE,TYPE) ; fILE THE DATA
  1.  N LINE,Y,I,CNT,RESULT
  1.  S CNT=$L(CODE,"~")
  1.  S LINE=""
  1.  F I=1:1:CNT S Y=$P(CODE,"~",I),RESULT=$P(Y,"^",1),LINE(.2,I,0)=RESULT
  1.  S LINE(.2,0)="^^"_CNT_"^"_CNT_"^"_$P(%,".")
  1.  Q:CNT<1  ; file the results if there is any
  1.  D ADD(MDIEN,TYPE,.LINE,CNT)
  1.  Q
  1.  ;
  1. ADD(MDIEN,TYPE,LINE,CNT) ;
  1.  ; Create an entry in the .1 node
  1.  N NODE,X
  1.  S NODE=$G(^MDD(703.1,MDIEN,.1,0)) Q:NODE=""
  1.  S NODE=$P(NODE,"^",3)
  1.  S NODE=NODE+1
  1.  S $P(^MDD(703.1,MDIEN,.1,0),"^",3,4)=NODE_"^"_NODE
  1.  S $P(^MDD(703.1,MDIEN,.1,NODE,0),"^")=TYPE
  1.  D NOW^%DTC
  1.  M ^MDD(703.1,MDIEN,.1,NODE)=LINE
  1.  Q
  1.  ;
  1. MSGIEN(MDHLIENS,MDHLREST) ; Return the message as definded in MDHLIENS  to the array in MDHLREST
  1.  ; Only TCP type messages
  1.  ; input: MDHLIENS= the intern entry number of the message in ^HLMA
  1.  ; MDHLREST = the return array that will contain the whole HL7 message
  1.  ; output: return "1^Message complete" if message was successful, "0^reason" if failed.
  1.  ;
  1.  N MDHLIEN,MDHLI,MDHLCNT,MDHLZ,RET
  1.  S (MDHLCNT,MDHLI,RET)=0
  1.  I $G(MDHLIENS)="" S RET=RET_"^No IEN defined" Q RET  ; Exit because no IEN for ^HLMA was provided
  1.  I $G(MDHLREST)="" S RET=RET_"^No Return ARRAY provided" Q RET  ; Exit because no return array was provided
  1.  I $G(^HLMA(MDHLIENS,0))="" S RET=RET_"^HLMA entry does not exist" Q RET  ; Exit because invalid OR non-EXISTING HLMA ENTRY
  1.  S MDHLIEN=$P(^HLMA(MDHLIENS,0),U)
  1.  I MDHLIEN="" S RET=RET_"^No pointer value to file 772" Q RET  ; No Pointer to 772
  1.  I $G(^HL(772,MDHLIEN,0))="" S RET=RET_"^772 Entry does not exist" Q RET  ; No 772 entry exist
  1.  ;get header
  1.  S MDHLZ=$G(^HLMA(MDHLIENS,"MSH",1,0))
  1.  I MDHLZ="" S RET=RET_"^No MSH segment found" Q RET  ; No MSH was found
  1.  S MDHLCNT=MDHLCNT+1,@MDHLREST@(MDHLCNT)=MDHLZ
  1.  S MDHLCNT=MDHLCNT+1,@MDHLREST@(MDHLCNT)=""
  1.  ;get body
  1.  S MDHLI=0
  1.  F  S MDHLI=$O(^HL(772,MDHLIEN,"IN",MDHLI)) Q:'MDHLI  D
  1.  . S MDHLCNT=MDHLCNT+1
  1.  . S @MDHLREST@(MDHLCNT)=$G(^HL(772,MDHLIEN,"IN",MDHLI,0))
  1.  . Q
  1.  I MDHLCNT'>2 S RET=RET_"^No message body found" Q RET  ; There was no body
  1.  S RET="1^Message complete"
  1.  Q RET
  1.  ;
  1. CICNV(MDIEN,RETURN) ; This subroutine will read the data in 703.1 and return the results
  1.  ;in the indicated global
  1.  N NODE,FLG
  1.  S FLG=1
  1.  Q:MDIEN=""  ; The ien was null
  1.  Q:RETURN=""  ; the array was null
  1.  S ARRAY(0)="0^0"
  1.  I $G(^MDD(703.1,MDIEN,.1,0))="" S FLG=0 Q  ; There is not data.
  1.  ; Start the processing of ICD/POV codes Value is 8
  1.  S NODE=0
  1.  I FLG I $G(^MDD(703.1,MDIEN,.1,0))'="" D
  1.  . F  S NODE=$O(^MDD(703.1,MDIEN,.1,NODE)) Q:NODE<1  D
  1.  . . S TYPE=$P($G(^MDD(703.1,MDIEN,.1,NODE,0),0),"^",1)
  1.  . . I TYPE=8 D PROCESS(MDIEN,NODE,TYPE,.ARRAY)
  1.  . . I TYPE=7 D PROCESS(MDIEN,NODE,TYPE,.ARRAY)
  1.  . . Q
  1.  . Q
  1.  M @RETURN=ARRAY
  1.  Q
  1. PROCESS(MDIEN,NODE,TYPE,ARRAY) ; This will process the data for each
  1.  N CNT,X,CONT,CODE,AR,TP,LOC
  1.  S CNT=0,CONT=0
  1.  F  S CNT=$O(^MDD(703.1,MDIEN,.1,NODE,.2,CNT)) Q:CNT<1  D
  1.  . S CODE=$G(^MDD(703.1,MDIEN,.1,NODE,.2,CNT,0),"") ; Grabbing the ICD9 AND CPT codes
  1.  . I CODE="" Q
  1.  . I TYPE=8 S AR=1,TP="POV",X=$$ICDDATA^ICDXCODE(80,CODE,$P($P(^MDD(703.1,MDIEN,0),"^",3),".",1)) Q:X=""
  1.  . 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
  1.  . S CONT=CONT+1
  1.  . S ARRAY(AR)=CONT_"^"_CONT
  1.  . I AR=1 D
  1.  . . N DESC,IN,LN
  1.  . . S IN=$P(X,"^",1) Q:IN<1
  1.  . . S DESC=$P(X,"^",4) Q:DESC=""
  1.  . . S I=CONT
  1.  . . S $P(ARRAY(AR,I),"^",1)=TP
  1.  . . S $P(ARRAY(AR,I),"^",2)=$P(X,"^",1)
  1.  . . S $P(ARRAY(AR,I),"^",3)=$P(X,"^",2)
  1.  . . S $P(ARRAY(AR,I),"^",5)=DESC
  1.  . . S $P(ARRAY(AR,I),"^",6)=$S(I=1:1,1:0)
  1.  . . Q
  1.  . I AR=2 D
  1.  . . N DESC,IN,LN,LEX,CPTCNT
  1.  . . S IN=$P(X,"^",1) Q:IN<1
  1.  . . D CPTLEX^MDRPCWU(.LEX,CODE,"CPT")
  1.  . . Q:$D(^TMP("MDLEX",$J))<1
  1.  . . S DESC="",CPTCNT=""
  1.  . . F  S CPTCNT=$O(^TMP("MDLEX",$J,CPTCNT)) Q:CPTCNT<1  D  Q:$L(DESC)>200
  1.  . . . N LINE
  1.  . . . S LINE=$P(^TMP("MDLEX",$J,CPTCNT),"^",3)
  1.  . . . Q:LINE=""
  1.  . . . S DESC=DESC_LINE_" "
  1.  . . . Q
  1.  . . I $L(DESC)>200 S DESC=$E(DESC,1,200)
  1.  . . ; S LN=$G(^ICPT(IN,0),0) Q:LN=""
  1.  . . ; S DESC=$P(X,"^",3) Q:DESC=""  ; DBIA1995 $$CPT^ICPTCOD(CODE) returns X and the second piece of X is the DESC
  1.  . . S I=CNT
  1.  . . S $P(ARRAY(AR,I),"^",1)=TP
  1.  . . S $P(ARRAY(AR,I),"^",2)=$P(X,"^",1)
  1.  . . S $P(ARRAY(AR,I),"^",3)=$P(X,"^",2)
  1.  . . S $P(ARRAY(AR,I),"^",5)=DESC
  1.  . . ; S $P(ARRAY(AR,I),"^",5)=LEX^MDRPCW1(RESULTS,CODE,"CPT") ; 02
  1.  . . S $P(ARRAY(AR,I),"^",7)=$S(I=1:1,1:0)
  1.  . . Q
  1.  . Q
  1.  I $D(ARRAY(1))!$D(ARRAY(2)) S ARRAY(0)="1^1"
  1.  Q
  1.  ;
  1. NOTICE(SUBJECT,TXT,DEVIEN,DUZ) ; This will fire off a mail message to the Indicated mail group saying that a study was deleted
  1.  ;
  1.  N INST,MG,XMTO,XMDUZ,XMSUBJ,XMBODY,N,X
  1.  S MG=0
  1.  S INST=DEVIEN
  1.  I INST>1 S MG=$P($G(^MDS(702.09,INST,0)),"^",2)
  1.  I 'MG!('$$MG^MDHL7U2(MG)) S MG=$$FIND1^DIC(3.8,"","BX","MD DEVICE ERRORS") Q:'MG
  1.  S MG=$$GET1^DIQ(3.8,+MG_",",.01)
  1.  S XMTO="G."_MG_"@"_^XMB("NETNAME"),XMINSTR("FROM")=.5
  1.  S XMBODY="TXT"
  1.  S XMSUBJ=SUBJECT
  1.  D SENDMSG^XMXAPI(DUZ,XMSUBJ,XMBODY,XMTO,.XMINSTR)
  1.  Q
  1.  ;
  1. ALERT(MDSIEN) ; This is to send an e-mail to the main device mail group that a study has been deleted
  1.  D NOW^%DTC
  1.  S SUBJECT="Study "_MDSIEN_" for Patient "_$$GET1^DIQ(702,MDSIEN,.01,"E")_" has been DELETED!"
  1.  S BODY(1)="The following study has been deleted."
  1.  S BODY(2)="         By the USER:       "_$$GET1^DIQ(200,DUZ,.01,"E")
  1.  S BODY(3)="             On Date:       "_$$FMTE^XLFDT(%,1)
  1.  S BODY(4)="           "
  1.  S BODY(5)="                   CP Study Information"
  1.  S BODY(6)="------------------------------------------------------------------------------ "
  1.  S BODY(7)="CP Study ID:       "_MDSIEN
  1.  S BODY(8)="CP Study Def:      "_$$GET1^DIQ(702,MDSIEN,.04,"E")
  1.  S BODY(9)="Created on:        "_$$FMTE^XLFDT($$GET1^DIQ(702,MDSIEN,.02,"I"),1)
  1.  S BODY(10)="Created by:        "_$$GET1^DIQ(702,MDSIEN,.03,"E")
  1.  S BODY(11)="On Instrument:     "_$$GET1^DIQ(702,MDSIEN,.11,"E")
  1.  S BODY(12)="For Patient:       "_$$GET1^DIQ(702,MDSIEN,.01,"E")
  1.  S BODY(13)="        SSN:       "_$E($$GET1^DIQ(702,MDSIEN,.011,"E"),6,9)
  1.  S BODY(14)="        DOB:       "_$$FMTE^XLFDT($$GET1^DIQ(702,MDSIEN,.012,"I"),1)
  1.  S DEVIEN=$$GET1^DIQ(702,MDSIEN,.11,"I")
  1.  Q