MDCPHL7B ;HINES OIFO/BJ - CliO HL7 Handler/validator;09 Aug 2006
;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
;Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine uses the following IAs:
; # 2434 - $$TOPURG^HLUTIL HL7 (supported)
; #10112 - $$SITE^VASITE() call Registration (supported)
; #10138 - access ^HL(772 HL7 (supported)
; # 3273 - access ^HLMA( HL7 (controlled subscription)
;
;only call via line tags.
Q
;
GTMSGIDS(MDCPRSLT,MDCPSTAT) ; Gets message ids
;
; Gets a list of message ids from the CLIO_HL7_LOG file (file 704.002)
; based on status.
;
; Parameters -
; Covert:
; None
; Overt:
; MDCPRSLT - The name of an array that will contain the results.
; MDCPSTAT - Internal code for status
; 1 = Entered
; 2 = Awaiting Processing
; 3 = Error
; 4 = Processed
;
; Returns -
; An array of IDs of entries in file 704.002
;
S MDCPRSLT=$NA(^TMP($J,"MDCPRSLT"))
N I,J S I=1,J=0
F S J=$O(^MDC(704.002,"AS",MDCPSTAT,J)) Q:'J D
.S @MDCPRSLT@(1,I)=J
.S I=I+1
S @MDCPRSLT=I_U
S @MDCPRSLT@(0)="0^"_I
Q
;
GETMSG(MDCPRSLT,MDCPMSG) ; Gets a message based on ID
;
; Gets a message based on ID from the HL7 subsystem.
; IA
; 10138 (supported) - Used to reference the incoming message text in 772
; ?? - SITE^VASITE extrinsic.
; Parameters -
; Overt:
; MDCPRSLT- The name of a global in which the message will be saved.
; MDCPMSG- The IEN of the HL7 message in 703.1.
;
; Returns -
; Root Node = Message ID (File 772 field 6)^Patient DFN^Facility
; Node 0 = Message MSH segment
; Node 1,n = The HL7 Message based on ID.
;
S MDCPRSLT=$NA(^TMP("MDCPGTWY",$J))
K @MDCPRSLT
N MDCPHL7
N MDCPDFN
S MDCPDFN=$P($G(^MDC(704.002,MDCPMSG,0)),U,6)
; Need to set ^TMP($J,"MDCPRSLT,0) to the MSH segment for the message.
; Again, we're going to assume that everything we'll need from the MSH segment will be on the first line.
N MDCPIEN S MDCPIEN=$P($G(^MDC(704.002,MDCPMSG,0)),U,4)
N MDCPIENS S MDCPIENS=$P($G(^MDC(704.002,MDCPMSG,0)),U,5)
S @MDCPRSLT@(-1,1)=$G(MDCPIENS)_U_$G(MDCPDFN)_U_$P($$SITE^VASITE(),U,3)
I +MDCPIEN>0 S @MDCPRSLT@(0,1)=$G(^HLMA(MDCPIEN,"MSH",1,0))
N I,MDCPHLSG S I=0
F S I=$O(^HL(772,MDCPIENS,"IN",I)) Q:'I D
.S MDCPHLSG=$G(^HL(772,MDCPIENS,"IN",I,0))
.I ($G(MDCPHLSG)'=" ")&($L(MDCPHLSG)>1) D
..S @MDCPRSLT@(1,I)=$G(^HL(772,MDCPIENS,"IN",I,0))
Q
;
UPDATERP(MDCPRSLT,MDCPMSG,MDCPSTAT,MDCPDFN,MDCPMAP) ; Updates CP RESULT REPORT status
;
; Sets the status field of the message identified by
; MDCPMSG in 704.002 to the status listed in status. Status
; must be in internal format.
;
; Parameters -
; Covert: none
; Overt:
; MDCPMSG - IFN of message in CP RESULT REPORT file
; MDCPSTAT - Status (in INTERNAL format).
; MDCPDFN - (Optional) The IFN of the patient in the patient file.
; MDCPMAP - (Optional) The identifier of the mapping table from CliO.
;
; Returns -
; MDCPRSLT: A variable passed by reference containing the results of the status update.
;
N MDCPFDA,MDCPPTID,MDCPIFN,MDCPERR,MDCPROC,MDCPEST,MDNOW,MDTMP
S MDCPIENS=$G(MDCPMSG)_","
D NOW^%DTC S MDNOW=%
S MDCPEST=$$EXTERNAL^DILFD(704.002,.02,"",MDCPSTAT)
S MDCPFDA(704.002,MDCPIENS,".02")=MDCPSTAT
S:+$G(MDCPSTAT)="4" MDCPFDA(704.002,MDCPIENS,".09")=MDNOW
;S:$D(MDCPDFN)#10 MDCPFDA(704.002,MDCPIENS,".06")=MDCPDFN
;S:$D(MDCPMAP)#10 MDCPFDA(704.002,MDCPIENS,".03")=MDCPMAP
D FILE^DIE("K","MDCPFDA","MDCPERR")
I $D(MDCPERR) D Q
.D UPDRSN(.MDTMP,MDCPMSG,"Unable to change status of entry '"_MDCPMSG_"' to "_$G(MDCPEST))
.S MDCPRSLT(0)="0^"_$G(MDCPERR(1,"TEXT",1),"Fileman didn't return a reason")
;
; Status change was successful - Now lets log it and keep going
;
D UPDRSN(.MDTMP,MDCPMSG,"Status of entry '"_MDCPMSG_"' changed to "_$G(MDCPEST))
S MDCPRSLT(0)="1^Status updated to "_MDCPEST
;
; We're going to get rid of the M trigger on the log file and directly notify the Windows service
; that we've got a message ready. While it was cool, there was too much of a chance of bad things
; happening if someone went in and edited this file and hit the trigger accidentally.
;
I MDCPSTAT=2 D Q
.S MDCPVDFN=$P($G(^MDC(704.002,MDCPMSG,0)),U,6)
.S MDCPVMAP=$P($G(^MDC(704.002,MDCPMSG,0)),U,3)
.I (+MDCPVDFN)&(MDCPVMAP]"") D Q
..D EN^MDCPSIGN(MDCPMSG) ; Message sent to the gateway!
.K MDCPVDFN,MDCPVMAP
.; Set message back to error
.S MDCPFDA(704.002,MDCPIENS,".02")=3
.D FILE^DIE("K","MDCPFDA","MDCPERR")
.D UPDRSN(.MDTMP,MDCPMSG,"Unable to change status of entry to "_$G(MDCPEST)_". Missing instrument or patient.")
.S MDCPRSLT(0)="0^Unable to change status, missing patient or instrument"
;
I $G(MDCPSTAT)="4" D Q
.S HLMTIENS=$P($G(^MDC(704.002,MDCPMSG,0)),U,4)
.I $$TOPURG^HLUTIL<0 D UPDRSN(.MDTMP,MDCPMSG,"Unable to purge entry "_$G(MDCPMSG))
;
Q
;
UPDRSN(MDCPRSLT,MDCPMSG,MDCPTEXT) ; Update CLIO_HL7_LOG file with a reason for a status.
; Published as MDCP UPDATE MESSAGE REASON
;
; Parameters -
; Covert: none
; Overt:
; MDCPMSG - IFN of message in CP RESULT REPORT file
; MDCPSTAT - The text to set place in .
;
; Returns -
; MDCPRSLT: A global variable $NA() containing the results of the status update.
;
S MDCPRSLT=$NA(^TMP($J)) K @MDCPRSLT
N MDCPFDA
D NOW^%DTC
S MDCPFDA(704.004,"+1,",.01)=MDCPMSG
S MDCPFDA(704.004,"+1,",.02)=%
S MDCPFDA(704.004,"+1,",.1)=MDCPTEXT
D UPDATE^DIE("","MDCPFDA")
S @MDCPRSLT="1^Message Log Updated"
S @MDCPRSLT@(0)="1^Message Log Updated"
Q
;
CLRERR ; Quick clear of the HL7 error log
N MDX,MDZ
W !,"Set all HL7 errors to processed" S %=2 D YN^DICN Q:%'=1
F MDX=0:0 S MDX=$O(^MDC(704.002,"AS",3,MDX)) Q:'MDX D UPDATERP(.MDZ,MDX,4) W "."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCPHL7B 6078 printed Apr 09, 2024@20:49:18 Page 2
MDCPHL7B ;HINES OIFO/BJ - CliO HL7 Handler/validator;09 Aug 2006
+1 ;;1.0;CLINICAL PROCEDURES;**16**;Apr 01, 2004;Build 280
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine uses the following IAs:
+5 ; # 2434 - $$TOPURG^HLUTIL HL7 (supported)
+6 ; #10112 - $$SITE^VASITE() call Registration (supported)
+7 ; #10138 - access ^HL(772 HL7 (supported)
+8 ; # 3273 - access ^HLMA( HL7 (controlled subscription)
+9 ;
+10 ;only call via line tags.
+11 QUIT
+12 ;
GTMSGIDS(MDCPRSLT,MDCPSTAT) ; Gets message ids
+1 ;
+2 ; Gets a list of message ids from the CLIO_HL7_LOG file (file 704.002)
+3 ; based on status.
+4 ;
+5 ; Parameters -
+6 ; Covert:
+7 ; None
+8 ; Overt:
+9 ; MDCPRSLT - The name of an array that will contain the results.
+10 ; MDCPSTAT - Internal code for status
+11 ; 1 = Entered
+12 ; 2 = Awaiting Processing
+13 ; 3 = Error
+14 ; 4 = Processed
+15 ;
+16 ; Returns -
+17 ; An array of IDs of entries in file 704.002
+18 ;
+19 SET MDCPRSLT=$NAME(^TMP($JOB,"MDCPRSLT"))
+20 NEW I,J
SET I=1
SET J=0
+21 FOR
SET J=$ORDER(^MDC(704.002,"AS",MDCPSTAT,J))
if 'J
QUIT
Begin DoDot:1
+22 SET @MDCPRSLT@(1,I)=J
+23 SET I=I+1
End DoDot:1
+24 SET @MDCPRSLT=I_U
+25 SET @MDCPRSLT@(0)="0^"_I
+26 QUIT
+27 ;
GETMSG(MDCPRSLT,MDCPMSG) ; Gets a message based on ID
+1 ;
+2 ; Gets a message based on ID from the HL7 subsystem.
+3 ; IA
+4 ; 10138 (supported) - Used to reference the incoming message text in 772
+5 ; ?? - SITE^VASITE extrinsic.
+6 ; Parameters -
+7 ; Overt:
+8 ; MDCPRSLT- The name of a global in which the message will be saved.
+9 ; MDCPMSG- The IEN of the HL7 message in 703.1.
+10 ;
+11 ; Returns -
+12 ; Root Node = Message ID (File 772 field 6)^Patient DFN^Facility
+13 ; Node 0 = Message MSH segment
+14 ; Node 1,n = The HL7 Message based on ID.
+15 ;
+16 SET MDCPRSLT=$NAME(^TMP("MDCPGTWY",$JOB))
+17 KILL @MDCPRSLT
+18 NEW MDCPHL7
+19 NEW MDCPDFN
+20 SET MDCPDFN=$PIECE($GET(^MDC(704.002,MDCPMSG,0)),U,6)
+21 ; Need to set ^TMP($J,"MDCPRSLT,0) to the MSH segment for the message.
+22 ; Again, we're going to assume that everything we'll need from the MSH segment will be on the first line.
+23 NEW MDCPIEN
SET MDCPIEN=$PIECE($GET(^MDC(704.002,MDCPMSG,0)),U,4)
+24 NEW MDCPIENS
SET MDCPIENS=$PIECE($GET(^MDC(704.002,MDCPMSG,0)),U,5)
+25 SET @MDCPRSLT@(-1,1)=$GET(MDCPIENS)_U_$GET(MDCPDFN)_U_$PIECE($$SITE^VASITE(),U,3)
+26 IF +MDCPIEN>0
SET @MDCPRSLT@(0,1)=$GET(^HLMA(MDCPIEN,"MSH",1,0))
+27 NEW I,MDCPHLSG
SET I=0
+28 FOR
SET I=$ORDER(^HL(772,MDCPIENS,"IN",I))
if 'I
QUIT
Begin DoDot:1
+29 SET MDCPHLSG=$GET(^HL(772,MDCPIENS,"IN",I,0))
+30 IF ($GET(MDCPHLSG)'=" ")&($LENGTH(MDCPHLSG)>1)
Begin DoDot:2
+31 SET @MDCPRSLT@(1,I)=$GET(^HL(772,MDCPIENS,"IN",I,0))
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
UPDATERP(MDCPRSLT,MDCPMSG,MDCPSTAT,MDCPDFN,MDCPMAP) ; Updates CP RESULT REPORT status
+1 ;
+2 ; Sets the status field of the message identified by
+3 ; MDCPMSG in 704.002 to the status listed in status. Status
+4 ; must be in internal format.
+5 ;
+6 ; Parameters -
+7 ; Covert: none
+8 ; Overt:
+9 ; MDCPMSG - IFN of message in CP RESULT REPORT file
+10 ; MDCPSTAT - Status (in INTERNAL format).
+11 ; MDCPDFN - (Optional) The IFN of the patient in the patient file.
+12 ; MDCPMAP - (Optional) The identifier of the mapping table from CliO.
+13 ;
+14 ; Returns -
+15 ; MDCPRSLT: A variable passed by reference containing the results of the status update.
+16 ;
+17 NEW MDCPFDA,MDCPPTID,MDCPIFN,MDCPERR,MDCPROC,MDCPEST,MDNOW,MDTMP
+18 SET MDCPIENS=$GET(MDCPMSG)_","
+19 DO NOW^%DTC
SET MDNOW=%
+20 SET MDCPEST=$$EXTERNAL^DILFD(704.002,.02,"",MDCPSTAT)
+21 SET MDCPFDA(704.002,MDCPIENS,".02")=MDCPSTAT
+22 if +$GET(MDCPSTAT)="4"
SET MDCPFDA(704.002,MDCPIENS,".09")=MDNOW
+23 ;S:$D(MDCPDFN)#10 MDCPFDA(704.002,MDCPIENS,".06")=MDCPDFN
+24 ;S:$D(MDCPMAP)#10 MDCPFDA(704.002,MDCPIENS,".03")=MDCPMAP
+25 DO FILE^DIE("K","MDCPFDA","MDCPERR")
+26 IF $DATA(MDCPERR)
Begin DoDot:1
+27 DO UPDRSN(.MDTMP,MDCPMSG,"Unable to change status of entry '"_MDCPMSG_"' to "_$GET(MDCPEST))
+28 SET MDCPRSLT(0)="0^"_$GET(MDCPERR(1,"TEXT",1),"Fileman didn't return a reason")
End DoDot:1
QUIT
+29 ;
+30 ; Status change was successful - Now lets log it and keep going
+31 ;
+32 DO UPDRSN(.MDTMP,MDCPMSG,"Status of entry '"_MDCPMSG_"' changed to "_$GET(MDCPEST))
+33 SET MDCPRSLT(0)="1^Status updated to "_MDCPEST
+34 ;
+35 ; We're going to get rid of the M trigger on the log file and directly notify the Windows service
+36 ; that we've got a message ready. While it was cool, there was too much of a chance of bad things
+37 ; happening if someone went in and edited this file and hit the trigger accidentally.
+38 ;
+39 IF MDCPSTAT=2
Begin DoDot:1
+40 SET MDCPVDFN=$PIECE($GET(^MDC(704.002,MDCPMSG,0)),U,6)
+41 SET MDCPVMAP=$PIECE($GET(^MDC(704.002,MDCPMSG,0)),U,3)
+42 IF (+MDCPVDFN)&(MDCPVMAP]"")
Begin DoDot:2
+43 ; Message sent to the gateway!
DO EN^MDCPSIGN(MDCPMSG)
End DoDot:2
QUIT
+44 KILL MDCPVDFN,MDCPVMAP
+45 ; Set message back to error
+46 SET MDCPFDA(704.002,MDCPIENS,".02")=3
+47 DO FILE^DIE("K","MDCPFDA","MDCPERR")
+48 DO UPDRSN(.MDTMP,MDCPMSG,"Unable to change status of entry to "_$GET(MDCPEST)_". Missing instrument or patient.")
+49 SET MDCPRSLT(0)="0^Unable to change status, missing patient or instrument"
End DoDot:1
QUIT
+50 ;
+51 IF $GET(MDCPSTAT)="4"
Begin DoDot:1
+52 SET HLMTIENS=$PIECE($GET(^MDC(704.002,MDCPMSG,0)),U,4)
+53 IF $$TOPURG^HLUTIL<0
DO UPDRSN(.MDTMP,MDCPMSG,"Unable to purge entry "_$GET(MDCPMSG))
End DoDot:1
QUIT
+54 ;
+55 QUIT
+56 ;
UPDRSN(MDCPRSLT,MDCPMSG,MDCPTEXT) ; Update CLIO_HL7_LOG file with a reason for a status.
+1 ; Published as MDCP UPDATE MESSAGE REASON
+2 ;
+3 ; Parameters -
+4 ; Covert: none
+5 ; Overt:
+6 ; MDCPMSG - IFN of message in CP RESULT REPORT file
+7 ; MDCPSTAT - The text to set place in .
+8 ;
+9 ; Returns -
+10 ; MDCPRSLT: A global variable $NA() containing the results of the status update.
+11 ;
+12 SET MDCPRSLT=$NAME(^TMP($JOB))
KILL @MDCPRSLT
+13 NEW MDCPFDA
+14 DO NOW^%DTC
+15 SET MDCPFDA(704.004,"+1,",.01)=MDCPMSG
+16 SET MDCPFDA(704.004,"+1,",.02)=%
+17 SET MDCPFDA(704.004,"+1,",.1)=MDCPTEXT
+18 DO UPDATE^DIE("","MDCPFDA")
+19 SET @MDCPRSLT="1^Message Log Updated"
+20 SET @MDCPRSLT@(0)="1^Message Log Updated"
+21 QUIT
+22 ;
CLRERR ; Quick clear of the HL7 error log
+1 NEW MDX,MDZ
+2 WRITE !,"Set all HL7 errors to processed"
SET %=2
DO YN^DICN
if %'=1
QUIT
+3 FOR MDX=0:0
SET MDX=$ORDER(^MDC(704.002,"AS",3,MDX))
if 'MDX
QUIT
DO UPDATERP(.MDZ,MDX,4)
WRITE "."
+4 QUIT
+5 ;
