VAFCADT2 ;ALB/RJS - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/6/06 8:24am
;;5.3;Registration;**91,179,209,415,494,484,508,692**;Aug 13, 1993
;hl7v1.6
;
;This routine builds ADT HL7 messages: A01 = Admission
; A02 = Transfer
; A03 = Discharge
; A08 = Treating Specialty Update
; A11 = Cancel Admission
; A12 = Cancel Transfer
; A13 = Cancel Discharge
;
;It is called by VAFCADT1, which is itself is called by the
;DGPM patient movement event driver.
;
;
BLDMSG(DFN,EVENT,VAFHDT,EVCODE,IEN,PIVOT,PV1) ;
;Required Variables are: DFN = IEN of Patient File
; EVENT = HL7 Event, A01, A02, A03, etc.
; VAFHDT = Date/Time of Admission, Transfer, etc
;
;Optional Variables are: Event Code = (EVCODE):A string literal which is
; inserted in the Event Reason
; Code Field of the EVN segment
; of the message. This serves to
; indicate that the message might
; need to be processed in a special
; way. PIMS ADT software uses the
; Event Code to indicate whether
; the message is the most recent
; "Snapshot" of the data "05" or
; a "Snapshot" of data that is
; followed by more recent data "04"
;
;
; IEN = The IEN of the Patient Movement
; that the HL7 message is being
; built from. This is especially
; useful for Discharge Movements
; where date/time (VAFHDT) is not
; enough information to retrieve
; the movement
;
; PIVOT = The PIMS Pivot number that
; uniquely identifies the ADMISSION
;
; PV1 = In the case of a "Deleted
; Admission" the record in the
; Patient Movement File has already
; been deleted. But, a PV1 segment
; can be built from the DGPMP
; variable that has been saved off
; by the DGPM Event Driver. This
; PV1 segment is passed a string
; literal that is built by a call
; to DGBUILD^VAFHAPV1 previous to
; calling this software.
;
K HLA N VAFDIAG,LIN,VAFSTR,DGREL,DGINC,DGINR,DGDEP,VAFZEL
;Q:($G(EVCODE)'="05")
;
K HL
I EVENT="A08" D INIT^HLFNC2("VAFC ADT-A08-TSP SERVER",.HL)
I EVENT'="A08" D INIT^HLFNC2("VAFC ADT-"_EVENT_" SERVER",.HL)
I $D(HL)#2 G EXIT
S LIN=1
S VAFSTR=$$COMMANUM^VAFCADT2(2,9)_",10B,11PC,"_$$COMMANUM^VAFCADT2(13,21)_",22B,"_$$COMMANUM^VAFCADT2(23,30)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFCPID(DFN,VAFSTR)
I +HLA("HLS",LIN)=-1 K HLA("HLS",2) G EXIT
;I $G(VAFPID(1))]"" S HLA("HLS",LIN,1)=VAFPID(1)
;I $G(VAFPID(2))]"" S HLA("HLS",LIN,2)=VAFPID(2)
MERGE HLA("HLS",LIN)=VAFPID K VAFPID
S $P(HLA("HLS",LIN),HLFS,2)=1 ;SET ID
S VAFSTR=$$COMMANUM(1,12)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPD1(DFN,VAFSTR)
S VAFSTR=$$COMMANUM(1,21)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZPD(DFN,VAFSTR)
S $P(HLA("HLS",LIN),HLFS,2)=1 ;SET ID
I EVENT="A11" D G NEXT
. S HLA("HLS",$$ADD(.LIN,1))=PV1
. S $P(HLA("HLS",LIN),HLFS,51)=$G(PIVOT) ; VISIT&SET ID'S
I EVENT="A01"!(EVENT="A03")!(EVENT="A08")!(EVENT="A12")!(EVENT="A13") D G NEXT
. S VAFSTR=$$COMMANUM(2,5)_","_$$COMMANUM(7,45)
. S HLA("HLS",$$ADD(.LIN,1))=$$IN^VAFHLPV1(DFN,VAFHDT,VAFSTR,$G(IEN),PIVOT,"",.VAFDIAG)
I EVENT="A02" D G NEXT
. S VAFSTR=$$COMMANUM(2,45)
. S HLA("HLS",$$ADD(.LIN,1))=$$IN^VAFHLPV1(DFN,VAFHDT,VAFSTR,$G(IEN),PIVOT,"",.VAFDIAG)
G EXIT
NEXT ;
S $P(HLA("HLS",LIN),HLFS,2)=1 ;PV1 SET ID
S HLA("HLS",1)="EVN"_HLFS_EVENT_HLFS_$$HLDATE^HLFNC(VAFHDT,"TS")_HLFS
S HLA("HLS",1)=HLA("HLS",1)_HLFS_$G(EVCODE) ;,1
;Get patient directory call center parameter
N VAFCCON
S VAFCCON=$$GET^XPAR("SYS","DG PT DIRECTORY CALL CENTER")
I VAFCCON S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPV2(DFN,IEN,",22,")
S VAFSTR=$$COMMANUM(1,4)
N HLAROL
D BLDROL^VAFCROL("HLAROL",DFN,VAFHDT,VAFSTR,$G(PIVOT),$G(IEN))
N I,J,K
S I=""
F K=1:1 S I=+$O(HLAROL(I)) Q:('I) D
. S J=""
. F S J=$O(HLAROL(I,J)) Q:(J="") D
. . S:('J) HLA("HLS",LIN+K)=HLAROL(I,J)
. . S:(J) HLA("HLS",LIN+K,J)=HLAROL(I,J)
S LIN=LIN+K-1
I (EVENT="A01")!(EVENT="A08")!(EVENT="A11")!(EVENT="A12")!(EVENT="A13") DO
. S HLA("HLS",$$ADD(.LIN,1))="DG1"_HLFS_1_HLFS_HLFS_HLFS_$$HLQ^VAFHUTL($G(VAFDIAG))
S VAFSTR=$$COMMANUM(1,5)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZSP(DFN,1,1)
S VAFSTR=$$COMMANUM(1,22)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEL(DFN,VAFSTR,2)
S VAFSTR=$$COMMANUM(1,9)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZCT(DFN,VAFSTR,1)
S VAFSTR=$$COMMANUM(1,8)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEM(DFN,VAFSTR,1,1)
D ALL^DGMTU21(DFN,"V",VAFHDT,"R")
S VAFSTR=$$COMMANUM(1,13)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1)
S VAFSTR=$$COMMANUM(1,10)
S HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
D:$D(VATRACE) LOOP
;
S COUNTER=""
F S COUNTER=$O(HLA("HLS",COUNTER)) Q:COUNTER'>0 D
.; I +(HLA("HLS",COUNTER))=-1 S HLERR="Bad "_COUNTER_" Segment"
. I +(HLA("HLS",COUNTER))=-1 S HL="Bad "_COUNTER_" Segment"
.
;
EXIT ;
;I $D(HL)=1 DO
;. S HLERR(1)=HL
;. D EBULL^VAFHUTL2(DFN,VAFHDT,PIVOT,"HLERR(")
I $D(HL)>1,$D(HLA("HLS")) DO
. I EVENT="A08" DO
. . D GENERATE^HLMA("VAFC ADT-A08-TSP SERVER","LM",1,.HLRST,"")
. E D GENERATE^HLMA("VAFC ADT-"_EVENT_" SERVER","LM",1,.HLRST,"")
.
D KVAR^VADPT,KVAR^VAFHLPV1 K HLA,HLERR
Q
LOOP ;
;
;
W !!
N XX S XX=0
F S XX=$O(HLA("HLS",XX)) Q:XX="" W !,HLA("HLS",XX)
Q
;
COMMANUM(FROM,TO) ;Build comma separated list of numbers
;Input : FROM - Starting number (default = 1)
; TO - Ending number (default = FROM)
;Output : Comma separated list of numbers between FROM and TO
; (Ex: 1,2,3)
;Notes : Call assumes FROM <= TO
;
S FROM=$G(FROM) S:(FROM="") FROM=1
S TO=$G(TO) S:(TO="") TO=FROM
N OUTPUT,X
S OUTPUT=FROM
F X=(FROM+1):1:TO S OUTPUT=(OUTPUT_","_X)
Q OUTPUT
;
ADD(LINE,COUNTER) ;Increments Line = Line + Counter
;Input : LINE - Line number
; COUNTER - Increment number
;Output : Updated LINE value
;
S LINE=$G(LINE),COUNTER=$G(COUNTER)
S LINE=LINE+COUNTER
Q LINE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCADT2 7363 printed Jan 18, 2025@04:02:09 Page 2
VAFCADT2 ;ALB/RJS - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/6/06 8:24am
+1 ;;5.3;Registration;**91,179,209,415,494,484,508,692**;Aug 13, 1993
+2 ;hl7v1.6
+3 ;
+4 ;This routine builds ADT HL7 messages: A01 = Admission
+5 ; A02 = Transfer
+6 ; A03 = Discharge
+7 ; A08 = Treating Specialty Update
+8 ; A11 = Cancel Admission
+9 ; A12 = Cancel Transfer
+10 ; A13 = Cancel Discharge
+11 ;
+12 ;It is called by VAFCADT1, which is itself is called by the
+13 ;DGPM patient movement event driver.
+14 ;
+15 ;
BLDMSG(DFN,EVENT,VAFHDT,EVCODE,IEN,PIVOT,PV1) ;
+1 ;Required Variables are: DFN = IEN of Patient File
+2 ; EVENT = HL7 Event, A01, A02, A03, etc.
+3 ; VAFHDT = Date/Time of Admission, Transfer, etc
+4 ;
+5 ;Optional Variables are: Event Code = (EVCODE):A string literal which is
+6 ; inserted in the Event Reason
+7 ; Code Field of the EVN segment
+8 ; of the message. This serves to
+9 ; indicate that the message might
+10 ; need to be processed in a special
+11 ; way. PIMS ADT software uses the
+12 ; Event Code to indicate whether
+13 ; the message is the most recent
+14 ; "Snapshot" of the data "05" or
+15 ; a "Snapshot" of data that is
+16 ; followed by more recent data "04"
+17 ;
+18 ;
+19 ; IEN = The IEN of the Patient Movement
+20 ; that the HL7 message is being
+21 ; built from. This is especially
+22 ; useful for Discharge Movements
+23 ; where date/time (VAFHDT) is not
+24 ; enough information to retrieve
+25 ; the movement
+26 ;
+27 ; PIVOT = The PIMS Pivot number that
+28 ; uniquely identifies the ADMISSION
+29 ;
+30 ; PV1 = In the case of a "Deleted
+31 ; Admission" the record in the
+32 ; Patient Movement File has already
+33 ; been deleted. But, a PV1 segment
+34 ; can be built from the DGPMP
+35 ; variable that has been saved off
+36 ; by the DGPM Event Driver. This
+37 ; PV1 segment is passed a string
+38 ; literal that is built by a call
+39 ; to DGBUILD^VAFHAPV1 previous to
+40 ; calling this software.
+41 ;
+42 KILL HLA
NEW VAFDIAG,LIN,VAFSTR,DGREL,DGINC,DGINR,DGDEP,VAFZEL
+43 ;Q:($G(EVCODE)'="05")
+44 ;
+45 KILL HL
+46 IF EVENT="A08"
DO INIT^HLFNC2("VAFC ADT-A08-TSP SERVER",.HL)
+47 IF EVENT'="A08"
DO INIT^HLFNC2("VAFC ADT-"_EVENT_" SERVER",.HL)
+48 IF $DATA(HL)#2
GOTO EXIT
+49 SET LIN=1
+50 SET VAFSTR=$$COMMANUM^VAFCADT2(2,9)_",10B,11PC,"_$$COMMANUM^VAFCADT2(13,21)_",22B,"_$$COMMANUM^VAFCADT2(23,30)
+51 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFCPID(DFN,VAFSTR)
+52 IF +HLA("HLS",LIN)=-1
KILL HLA("HLS",2)
GOTO EXIT
+53 ;I $G(VAFPID(1))]"" S HLA("HLS",LIN,1)=VAFPID(1)
+54 ;I $G(VAFPID(2))]"" S HLA("HLS",LIN,2)=VAFPID(2)
+55 MERGE HLA("HLS",LIN)=VAFPID
KILL VAFPID
+56 ;SET ID
SET $PIECE(HLA("HLS",LIN),HLFS,2)=1
+57 SET VAFSTR=$$COMMANUM(1,12)
+58 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPD1(DFN,VAFSTR)
+59 SET VAFSTR=$$COMMANUM(1,21)
+60 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZPD(DFN,VAFSTR)
+61 ;SET ID
SET $PIECE(HLA("HLS",LIN),HLFS,2)=1
+62 IF EVENT="A11"
Begin DoDot:1
+63 SET HLA("HLS",$$ADD(.LIN,1))=PV1
+64 ; VISIT&SET ID'S
SET $PIECE(HLA("HLS",LIN),HLFS,51)=$GET(PIVOT)
End DoDot:1
GOTO NEXT
+65 IF EVENT="A01"!(EVENT="A03")!(EVENT="A08")!(EVENT="A12")!(EVENT="A13")
Begin DoDot:1
+66 SET VAFSTR=$$COMMANUM(2,5)_","_$$COMMANUM(7,45)
+67 SET HLA("HLS",$$ADD(.LIN,1))=$$IN^VAFHLPV1(DFN,VAFHDT,VAFSTR,$GET(IEN),PIVOT,"",.VAFDIAG)
End DoDot:1
GOTO NEXT
+68 IF EVENT="A02"
Begin DoDot:1
+69 SET VAFSTR=$$COMMANUM(2,45)
+70 SET HLA("HLS",$$ADD(.LIN,1))=$$IN^VAFHLPV1(DFN,VAFHDT,VAFSTR,$GET(IEN),PIVOT,"",.VAFDIAG)
End DoDot:1
GOTO NEXT
+71 GOTO EXIT
NEXT ;
+1 ;PV1 SET ID
SET $PIECE(HLA("HLS",LIN),HLFS,2)=1
+2 SET HLA("HLS",1)="EVN"_HLFS_EVENT_HLFS_$$HLDATE^HLFNC(VAFHDT,"TS")_HLFS
+3 ;,1
SET HLA("HLS",1)=HLA("HLS",1)_HLFS_$GET(EVCODE)
+4 ;Get patient directory call center parameter
+5 NEW VAFCCON
+6 SET VAFCCON=$$GET^XPAR("SYS","DG PT DIRECTORY CALL CENTER")
+7 IF VAFCCON
SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLPV2(DFN,IEN,",22,")
+8 SET VAFSTR=$$COMMANUM(1,4)
+9 NEW HLAROL
+10 DO BLDROL^VAFCROL("HLAROL",DFN,VAFHDT,VAFSTR,$GET(PIVOT),$GET(IEN))
+11 NEW I,J,K
+12 SET I=""
+13 FOR K=1:1
SET I=+$ORDER(HLAROL(I))
if ('I)
QUIT
Begin DoDot:1
+14 SET J=""
+15 FOR
SET J=$ORDER(HLAROL(I,J))
if (J="")
QUIT
Begin DoDot:2
+16 if ('J)
SET HLA("HLS",LIN+K)=HLAROL(I,J)
+17 if (J)
SET HLA("HLS",LIN+K,J)=HLAROL(I,J)
End DoDot:2
End DoDot:1
+18 SET LIN=LIN+K-1
+19 IF (EVENT="A01")!(EVENT="A08")!(EVENT="A11")!(EVENT="A12")!(EVENT="A13")
Begin DoDot:1
+20 SET HLA("HLS",$$ADD(.LIN,1))="DG1"_HLFS_1_HLFS_HLFS_HLFS_$$HLQ^VAFHUTL($GET(VAFDIAG))
End DoDot:1
+21 SET VAFSTR=$$COMMANUM(1,5)
+22 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZSP(DFN,1,1)
+23 SET VAFSTR=$$COMMANUM(1,22)
+24 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEL(DFN,VAFSTR,2)
+25 SET VAFSTR=$$COMMANUM(1,9)
+26 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZCT(DFN,VAFSTR,1)
+27 SET VAFSTR=$$COMMANUM(1,8)
+28 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEM(DFN,VAFSTR,1,1)
+29 DO ALL^DGMTU21(DFN,"V",VAFHDT,"R")
+30 SET VAFSTR=$$COMMANUM(1,13)
+31 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZIR(+$GET(DGINR("V")),VAFSTR,1)
+32 SET VAFSTR=$$COMMANUM(1,10)
+33 SET HLA("HLS",$$ADD(.LIN,1))=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
+34 if $DATA(VATRACE)
DO LOOP
+35 ;
+36 SET COUNTER=""
+37 FOR
SET COUNTER=$ORDER(HLA("HLS",COUNTER))
if COUNTER'>0
QUIT
Begin DoDot:1
+38 ; I +(HLA("HLS",COUNTER))=-1 S HLERR="Bad "_COUNTER_" Segment"
+39 IF +(HLA("HLS",COUNTER))=-1
SET HL="Bad "_COUNTER_" Segment"
+40 End DoDot:1
+41 ;
EXIT ;
+1 ;I $D(HL)=1 DO
+2 ;. S HLERR(1)=HL
+3 ;. D EBULL^VAFHUTL2(DFN,VAFHDT,PIVOT,"HLERR(")
+4 IF $DATA(HL)>1
IF $DATA(HLA("HLS"))
Begin DoDot:1
+5 IF EVENT="A08"
Begin DoDot:2
+6 DO GENERATE^HLMA("VAFC ADT-A08-TSP SERVER","LM",1,.HLRST,"")
End DoDot:2
+7 IF '$TEST
DO GENERATE^HLMA("VAFC ADT-"_EVENT_" SERVER","LM",1,.HLRST,"")
+8 End DoDot:1
+9 DO KVAR^VADPT
DO KVAR^VAFHLPV1
KILL HLA,HLERR
+10 QUIT
LOOP ;
+1 ;
+2 ;
+3 WRITE !!
+4 NEW XX
SET XX=0
+5 FOR
SET XX=$ORDER(HLA("HLS",XX))
if XX=""
QUIT
WRITE !,HLA("HLS",XX)
+6 QUIT
+7 ;
COMMANUM(FROM,TO) ;Build comma separated list of numbers
+1 ;Input : FROM - Starting number (default = 1)
+2 ; TO - Ending number (default = FROM)
+3 ;Output : Comma separated list of numbers between FROM and TO
+4 ; (Ex: 1,2,3)
+5 ;Notes : Call assumes FROM <= TO
+6 ;
+7 SET FROM=$GET(FROM)
if (FROM="")
SET FROM=1
+8 SET TO=$GET(TO)
if (TO="")
SET TO=FROM
+9 NEW OUTPUT,X
+10 SET OUTPUT=FROM
+11 FOR X=(FROM+1):1:TO
SET OUTPUT=(OUTPUT_","_X)
+12 QUIT OUTPUT
+13 ;
ADD(LINE,COUNTER) ;Increments Line = Line + Counter
+1 ;Input : LINE - Line number
+2 ; COUNTER - Increment number
+3 ;Output : Updated LINE value
+4 ;
+5 SET LINE=$GET(LINE)
SET COUNTER=$GET(COUNTER)
+6 SET LINE=LINE+COUNTER
+7 QUIT LINE
