MDCADT ;HINES OIFO/DP/BJ/TJ - HL7 Build ADT Axx Messages;10 Aug 2007
;;1.0;CLINICAL PROCEDURES;**16,12**;Apr 01, 2004;Build 318
; Per VHA Directive 2004-038, this routine should not be modified.
;
; This routine uses the following Integration Agreements (IAs):
; # 2050 - $$EZBLD^DIALOG() FileMan (supported)
; # 2887 - $$GETAPP^HLCS2 call HL7 (supported)
; #10106 - $$HLDATE^HLFNC HL7 (supported)
; #10070 - ^XMD call MailMan (supported)
; #10035 - access ^DPT( Registration (supported)
;
VALID ;HL7 MESSAGE BUILDER
; Creates HL7 V2.4 "Axx Type" message
; stolen from GMVVDEF1
; segments returned will fall into 1 of four categories
; Case 1 = simple unsubscripted variable e.g. SEG="IN1^Blue Cross.....^^"
; Case 2 = single segment, 2 or more nodes e.g. SEG="PD1^Smith,John...^^"
; SEG(1)="3505 94ST^....^^"
; Case 3 = Multiple segments, 1 node each e.g. SEG(1,0)="NK1^Smith,Mary^2...^^"
; SEG(2,0)="NK1^Smith,Joey^3...^^"
; Case 4 = Multiple segments, 1 or more nodes e.g. SEG(1,0)="ZCL^ data ...^^"
; SEG(1,0,1)="^ more data ...^^"
; SEG(1,0,2)="^ end of data ...^^"
; SEG(2,0)="ZCL^ all of segment ^^"
; SEG(3,0)="ZCL^ another segment ^^"
; SEG(3,0,1)=" etc., etc. ^^"
; I $D(SEG)=1 Case 1
; I $D(SEG)=11 Case 2
; I $D(SEG)=10 Case 3 or 4
Q
;
BLDMSG(KEY,VFLAG,OUT,MSHP,MDCEVN) ;
;
; Inputs:
; KEY - IEN of file to create message from
; VFLAG - "V" for VistA HL7 destination (default)
; OUT - target ARRAY, passed by reference
; MSHP - "ADT"
; MDCEVN - message type, e.g. A04
;
; Output: Two part string with parts separated by "^"
; Part 1: "LM" - output in local array passed in "OUT" parameter
; "GM" - output in ^TMP("HLS",$J)
; Part 2: No longer used ;
;
N MDCMAIL,IENSSAVE,TARGET
N MDCS,EV,MDCERAY,MDCERR,MDCSEG,MDCIEN
;
S IENSSAVE=$G(IENS)
S MDCIEN=KEY,MDCS=0
K ^TMP("HLS",$J),OUT
;S ARRAY="^TMP("_"""HLS"""_",$J,MDCS)",TARGET="GM^" ; array is a global
S ARRAY="OUT("_"""HLS"""_",MDCS)",TARGET="LM^" ; array is a local variable
;
; Get DATA
M MDCDATA=^MDC(704.005,KEY)
;
; Validate Patient Movement Data
;
I '$D(MDCDATA) D Q TARGET
. S MDCERAY(1)=KEY
. S MDCERR=$$EZBLD^DIALOG(7040020.002,.MDCERAY)
. D ERR(MDCERR)
;
; Get and Validate Patient IEN
S DFN=+$P($G(MDCDATA(0)),U)
I '$D(^DPT(DFN,0))!(DFN=0) D Q TARGET
. S MDCERAY(1)=DFN
. S MDCERR=$$EZBLD^DIALOG(7040020.003,.MDCERAY)
. D ERR(MDCERR)
;
; Build segments
;
EVN ; EVN - Event Type with EVN.7.1 - required
D EN^MDCEVN(MDCEVN,.MDCIEN,.MDCSEG,.MDCERR) I $D(MDCERR) D ERR(MDCERR) Q TARGET
I '$D(MDCSEG) D Q TARGET ; missing segment
. S MDCPARM(1)="EVN",MDCPARM(2)=+$G(MDCIEN),MDCPARM(3)=405
. S MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
. D ERR(MDCERR)
D SAVE
;
PID ; PID - Patient Identification - required
D EN^MDCPID(DFN,.MDCSEG,.MDCERR) I $D(MDCERR) D ERR(MDCERR) Q TARGET
I '$D(MDCSEG) D Q TARGET ; missing segment
. S MDCPARM(1)="PID",MDCPARM(2)=DFN,MDCPARM(3)=2
. S MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
. D ERR(MDCERR)
D SAVE
;
PV1 ; PV1 - Patient Visit - required or empty
D EN^MDCPV1(.MDCDATA,.MDCSEG,.MDCERR) I $D(MDCERR) D ERR(MDCERR) Q TARGET
I '$D(MDCSEG) D Q TARGET ; missing segment
. S MDCPARM(1)="PV1",MDCPARM(MDCIEN)=DFN,MDCPARM(3)=405
. S MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
. D ERR(MDCERR)
D SAVE
;
; Done building segments, clean up and exit
K PARAM,MDCSITE,MDCDATA
Q TARGET
;
SAVE ;
I $D(MDCSEG)#10 D ; single segment, one node
. S MDCS=MDCS+1
. M @ARRAY=MDCSEG
I $D(MDCSEG)=10 D ; maybe multiple segments, multiple nodes
. N I
. S I=""
. F D Q:I=""
.. S I=$O(MDCSEG(I)) Q:I=""
.. S MDCS=MDCS+1
.. M @ARRAY=MDCSEG(I,0)
K MDCSEG
; Move local array to global if it's getting too big
I $P(TARGET,U)="LM",$S<16000 D
. K ^TMP("HLS",$J) M ^TMP("HLS",$J)=OUT("HLS") K OUT("HLS")
. S $P(TARGET,U)="GM",ARRAY="^TMP("_"""HLS"""_",$J,MDCS)"
Q
;
; Error Processing
ERR(MDCERR) ;
; Input: MDCERR - Error message.
N IENS,ZTSTOP
S IENS=$G(IENSSAVE,MDCIEN)
D MAILERR
S ZTSTOP=1
K MDCPARM,OUT
Q
;
; Mail Message
MAILERR ; mail error notification to g.developers
N RECEIVER,XMDUZ,XMY,XMSUB,XMTEXT,HL7DATE,%
D NOW^%DTC
S HL7DATE=$$HLDATE^HLFNC(%,"TS")
S RECEIVER=$$GETAPP^HLCS2(HL("SAN"))
S RECEIVER="g."_$P(RECEIVER,U)
S XMDUZ=.5
S XMY(RECEIVER)=""
S XMSUB=" CP Flowsheets HL7 Error Message; file# 704.005 IEN ="_KEY_" (ADT Event #"_MDCEVN_")"
S XMTEXT="MDCMAIL("
S MDCMAIL(1)=MDCERR
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDCADT 5312 printed Dec 13, 2024@01:42:19 Page 2
MDCADT ;HINES OIFO/DP/BJ/TJ - HL7 Build ADT Axx Messages;10 Aug 2007
+1 ;;1.0;CLINICAL PROCEDURES;**16,12**;Apr 01, 2004;Build 318
+2 ; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; This routine uses the following Integration Agreements (IAs):
+5 ; # 2050 - $$EZBLD^DIALOG() FileMan (supported)
+6 ; # 2887 - $$GETAPP^HLCS2 call HL7 (supported)
+7 ; #10106 - $$HLDATE^HLFNC HL7 (supported)
+8 ; #10070 - ^XMD call MailMan (supported)
+9 ; #10035 - access ^DPT( Registration (supported)
+10 ;
VALID ;HL7 MESSAGE BUILDER
+1 ; Creates HL7 V2.4 "Axx Type" message
+2 ; stolen from GMVVDEF1
+3 ; segments returned will fall into 1 of four categories
+4 ; Case 1 = simple unsubscripted variable e.g. SEG="IN1^Blue Cross.....^^"
+5 ; Case 2 = single segment, 2 or more nodes e.g. SEG="PD1^Smith,John...^^"
+6 ; SEG(1)="3505 94ST^....^^"
+7 ; Case 3 = Multiple segments, 1 node each e.g. SEG(1,0)="NK1^Smith,Mary^2...^^"
+8 ; SEG(2,0)="NK1^Smith,Joey^3...^^"
+9 ; Case 4 = Multiple segments, 1 or more nodes e.g. SEG(1,0)="ZCL^ data ...^^"
+10 ; SEG(1,0,1)="^ more data ...^^"
+11 ; SEG(1,0,2)="^ end of data ...^^"
+12 ; SEG(2,0)="ZCL^ all of segment ^^"
+13 ; SEG(3,0)="ZCL^ another segment ^^"
+14 ; SEG(3,0,1)=" etc., etc. ^^"
+15 ; I $D(SEG)=1 Case 1
+16 ; I $D(SEG)=11 Case 2
+17 ; I $D(SEG)=10 Case 3 or 4
+18 QUIT
+19 ;
BLDMSG(KEY,VFLAG,OUT,MSHP,MDCEVN) ;
+1 ;
+2 ; Inputs:
+3 ; KEY - IEN of file to create message from
+4 ; VFLAG - "V" for VistA HL7 destination (default)
+5 ; OUT - target ARRAY, passed by reference
+6 ; MSHP - "ADT"
+7 ; MDCEVN - message type, e.g. A04
+8 ;
+9 ; Output: Two part string with parts separated by "^"
+10 ; Part 1: "LM" - output in local array passed in "OUT" parameter
+11 ; "GM" - output in ^TMP("HLS",$J)
+12 ; Part 2: No longer used ;
+13 ;
+14 NEW MDCMAIL,IENSSAVE,TARGET
+15 NEW MDCS,EV,MDCERAY,MDCERR,MDCSEG,MDCIEN
+16 ;
+17 SET IENSSAVE=$GET(IENS)
+18 SET MDCIEN=KEY
SET MDCS=0
+19 KILL ^TMP("HLS",$JOB),OUT
+20 ;S ARRAY="^TMP("_"""HLS"""_",$J,MDCS)",TARGET="GM^" ; array is a global
+21 ; array is a local variable
SET ARRAY="OUT("_"""HLS"""_",MDCS)"
SET TARGET="LM^"
+22 ;
+23 ; Get DATA
+24 MERGE MDCDATA=^MDC(704.005,KEY)
+25 ;
+26 ; Validate Patient Movement Data
+27 ;
+28 IF '$DATA(MDCDATA)
Begin DoDot:1
+29 SET MDCERAY(1)=KEY
+30 SET MDCERR=$$EZBLD^DIALOG(7040020.002,.MDCERAY)
+31 DO ERR(MDCERR)
End DoDot:1
QUIT TARGET
+32 ;
+33 ; Get and Validate Patient IEN
+34 SET DFN=+$PIECE($GET(MDCDATA(0)),U)
+35 IF '$DATA(^DPT(DFN,0))!(DFN=0)
Begin DoDot:1
+36 SET MDCERAY(1)=DFN
+37 SET MDCERR=$$EZBLD^DIALOG(7040020.003,.MDCERAY)
+38 DO ERR(MDCERR)
End DoDot:1
QUIT TARGET
+39 ;
+40 ; Build segments
+41 ;
EVN ; EVN - Event Type with EVN.7.1 - required
+1 DO EN^MDCEVN(MDCEVN,.MDCIEN,.MDCSEG,.MDCERR)
IF $DATA(MDCERR)
DO ERR(MDCERR)
QUIT TARGET
+2 ; missing segment
IF '$DATA(MDCSEG)
Begin DoDot:1
+3 SET MDCPARM(1)="EVN"
SET MDCPARM(2)=+$GET(MDCIEN)
SET MDCPARM(3)=405
+4 SET MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
+5 DO ERR(MDCERR)
End DoDot:1
QUIT TARGET
+6 DO SAVE
+7 ;
PID ; PID - Patient Identification - required
+1 DO EN^MDCPID(DFN,.MDCSEG,.MDCERR)
IF $DATA(MDCERR)
DO ERR(MDCERR)
QUIT TARGET
+2 ; missing segment
IF '$DATA(MDCSEG)
Begin DoDot:1
+3 SET MDCPARM(1)="PID"
SET MDCPARM(2)=DFN
SET MDCPARM(3)=2
+4 SET MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
+5 DO ERR(MDCERR)
End DoDot:1
QUIT TARGET
+6 DO SAVE
+7 ;
PV1 ; PV1 - Patient Visit - required or empty
+1 DO EN^MDCPV1(.MDCDATA,.MDCSEG,.MDCERR)
IF $DATA(MDCERR)
DO ERR(MDCERR)
QUIT TARGET
+2 ; missing segment
IF '$DATA(MDCSEG)
Begin DoDot:1
+3 SET MDCPARM(1)="PV1"
SET MDCPARM(MDCIEN)=DFN
SET MDCPARM(3)=405
+4 SET MDCERR=$$EZBLD^DIALOG(7040020.004,.MDCPARM)
+5 DO ERR(MDCERR)
End DoDot:1
QUIT TARGET
+6 DO SAVE
+7 ;
+8 ; Done building segments, clean up and exit
+9 KILL PARAM,MDCSITE,MDCDATA
+10 QUIT TARGET
+11 ;
SAVE ;
+1 ; single segment, one node
IF $DATA(MDCSEG)#10
Begin DoDot:1
+2 SET MDCS=MDCS+1
+3 MERGE @ARRAY=MDCSEG
End DoDot:1
+4 ; maybe multiple segments, multiple nodes
IF $DATA(MDCSEG)=10
Begin DoDot:1
+5 NEW I
+6 SET I=""
+7 FOR
Begin DoDot:2
+8 SET I=$ORDER(MDCSEG(I))
if I=""
QUIT
+9 SET MDCS=MDCS+1
+10 MERGE @ARRAY=MDCSEG(I,0)
End DoDot:2
if I=""
QUIT
End DoDot:1
+11 KILL MDCSEG
+12 ; Move local array to global if it's getting too big
+13 IF $PIECE(TARGET,U)="LM"
IF $STORAGE<16000
Begin DoDot:1
+14 KILL ^TMP("HLS",$JOB)
MERGE ^TMP("HLS",$JOB)=OUT("HLS")
KILL OUT("HLS")
+15 SET $PIECE(TARGET,U)="GM"
SET ARRAY="^TMP("_"""HLS"""_",$J,MDCS)"
End DoDot:1
+16 QUIT
+17 ;
+18 ; Error Processing
ERR(MDCERR) ;
+1 ; Input: MDCERR - Error message.
+2 NEW IENS,ZTSTOP
+3 SET IENS=$GET(IENSSAVE,MDCIEN)
+4 DO MAILERR
+5 SET ZTSTOP=1
+6 KILL MDCPARM,OUT
+7 QUIT
+8 ;
+9 ; Mail Message
MAILERR ; mail error notification to g.developers
+1 NEW RECEIVER,XMDUZ,XMY,XMSUB,XMTEXT,HL7DATE,%
+2 DO NOW^%DTC
+3 SET HL7DATE=$$HLDATE^HLFNC(%,"TS")
+4 SET RECEIVER=$$GETAPP^HLCS2(HL("SAN"))
+5 SET RECEIVER="g."_$PIECE(RECEIVER,U)
+6 SET XMDUZ=.5
+7 SET XMY(RECEIVER)=""
+8 SET XMSUB=" CP Flowsheets HL7 Error Message; file# 704.005 IEN ="_KEY_" (ADT Event #"_MDCEVN_")"
+9 SET XMTEXT="MDCMAIL("
+10 SET MDCMAIL(1)=MDCERR
+11 DO ^XMD
+12 QUIT
