VAFCMSG3 ;ALB/JRP,PKE-Message Builder Utilities ; 4/26/03 12:05pm
;;5.3;Registration;**91,209,149,261,307,494,484,477**;Aug 13, 1993
;
;-- Line tags for building HL7 segments
;
; Standardized variable names:
; All HL7 variables created by calling INIT^HLFNC2() must exist
; DFN - Pointer to entry in PATIENT file (#2)
; EVNTHL7 - HL7 ADT event being transmitted
; EVNTDATE - Date/time event occurred (FileMan format)
; EVNTINFO() - Array containing extra info needed to build segments
; (full global reference)
; VAFSTR - String of fields to put into segment separated by commas
;
BLDEVN S VAFEVN=$$EN^VAFHLEVN(EVNTHL7,EVNTDATE,VAFSTR,HL("Q"),HL("FS"))
;Manually add event type code (seq #1)
S $P(VAFEVN,HL("FS"),2)=EVNTHL7
;Manually add event reason code (seq #4)
S $P(VAFEVN,HL("FS"),5)=$G(@EVNTINFO@("REASON",1))
;If applicable, manually add operator (seq #5)
S:($D(@EVNTINFO@("USER"))) $P(VAFEVN,HL("FS"),6)=@EVNTINFO@("USER")
Q
BLDPID ;
S VAFPID=$$EN^VAFCPID(DFN,VAFSTR)
;CHECK IF PATIENT HAS AN ICN IF NOT A28
I $P(VAFPID,HL("FS"),3)=HLQ&(EVNTHL7'="A28") D
. I $T(GETICN^MPIF001)']"" Q
. ; returns National ICN -- don't create local ICN
. N ICN S ICN=$$GETICN^MPIF001(DFN)
. I +ICN>0 S $P(VAFPID,HL("FS"),3)=ICN
Q
;
BLDPD1 ;
I EVNTHL7="A28" D
. N CHANGE,CMOR
. N X S X="MPIF001" X ^%ZOSF("TEST") Q:'$T
. I +$$GETVCCI^MPIF001(DFN)'>0 D
. . ;S CMOR=$P($$SITE^VASITE(),"^")
. . ;S CHANGE=$$CHANGE^MPIF001(DFN,CMOR)
. . ;I +CHANGE<0 D START^RGHLLOG(),EXC^RGHLLOG(211,"Trouble updating CMOR while building A28 msg in VAFCMSG3 for DFN = "_DFN),STOP^RGHLLOG()
S VAFPD1=$$EN^VAFHLPD1(DFN)
;
BLDPV1 I EVNTHL7="A28" S VAFPV1="PV1"_HL("FS")_1
E S VAFPV1=$$EN^VAFCPV1(DFN) Q
;
BLDROL ;
I $G(@EVNTINFO@("SERVER PROTOCOL"))'="VAFC ADT-A08-SDAM SERVER"
IF I $G(^DPT(DFN,.1))]"" DO
. D BLDROL^VAFCROL("VAFROL",DFN,EVNTDATE,VAFSTR,$G(@EVNTINFO@("PIVOT")))
Q
;
BLDOBX ;
N VAFARRY S SECINFO=$$EN^VAFHLZSN(DFN) I $P(SECINFO,"^",2)'="",$P(SECINFO,"^",2)'?.2"""" D ;**477
. S VAFARRY(2)="CE"
. S $P(VAFARRY(3),$E(HL("ECH"),1),2)="SECURITY LEVEL"
. S VAFARRY(5)=$P(SECINFO,"^",2)
. S VAFARRY(11)="F"
. S VAFARRY(14)=$$FMDATE^HLFNC($P(SECINFO,"^",4))
. S VAFARRY(16)=$P(SECINFO,"^",3)
;
S VAFOBX=$$EN^VAFHLOBX(.VAFARRY) K SECINFO
Q
;
BLDZPD S VAFZPD=$$EN^VAFHLZPD(DFN,VAFSTR) Q
;
BLDZSP S VAFZSP=$$EN^VAFHLZSP(DFN) Q
;
BLDZEL S VAFZEL=$$EN^VAFHLZEL(DFN,VAFSTR,1) Q
;
BLDZCT S VAFZCT=$$EN^VAFHLZCT(DFN,VAFSTR) Q
;
BLDZEM S VAFZEM=$$EN^VAFHLZEM(DFN,VAFSTR) Q
;
BLDZFF S VAFZFF="ZFF"_HL("FS")_2_HL("FS")
S VAFZFF=VAFZFF_$P($G(^VAT(391.71,+$G(@EVNTINFO@("PIVOT")),2)),U)
Q
;
BLDZIR K DGREL,DGINC,DGINR,DGDEP
D ALL^DGMTU21(DFN,"V",EVNTDATE,"R")
S VAFZIR=$$EN^VAFHLZIR(+$G(DGINR("V")),VAFSTR,1)
K DGREL,DGINC,DGINR,DGDEP
Q
;
BLDZEN S VAFZEN=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS")) Q
;
;
;-- Line tags for copying HL7 segments into HL7 message
;
; Standardized variable names:
; Variables set by BLDxxx tags
; XMITARRY - Array to build HL7 message into (full global reference)
; LASTLINE - Last line number used in HL7 message
; - This value will be incremented appropriately
; LINESADD - Total number of lines added to HL7 message
; - This value will be incremented appropriately
;
CPYEVN N I
S LASTLINE=1+$G(LASTLINE)
S @XMITARRY@(LASTLINE)=VAFEVN
S LINESADD=1+$G(LINESADD)
S I=""
F S I=+$O(VAFEVN(I)) Q:('I) D
.S @XMITARRY@(LASTLINE,I)=VAFEVN(I)
.S LINESADD=LINESADD+1
Q
; rev $o is # lines from array
CPYPID S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPID(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFPID Q
;
CPYPD1 S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPD1(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFPD1 Q
;
CPYPV1 S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFPV1(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFPV1 Q
;
CPYROL N I,J,K
S I=""
F K=1:1 S I=+$O(VAFROL(I)) Q:('I) D
. S J=""
. F S J=$O(VAFROL(I,J)) Q:(J="") D
. . S:('J) @XMITARRY@(LASTLINE+K)=VAFROL(I,J)
. . S:(J) @XMITARRY@(LASTLINE+K,J)=VAFROL(I,J)
. . S LINESADD=1+$G(LINESADD)
S LASTLINE=LASTLINE+K-1
Q
;
CPYOBX S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFOBX(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFOBX Q
;
CPYZPD S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZPD(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZPD Q
;
CPYZSP S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZSP(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZSP Q
;
CPYZEL S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZEL(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZEL Q
;
CPYZCT S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZCT(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZCT Q
;
CPYZEM S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZEM(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZEM Q
;
CPYZFF S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZFF(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZFF Q
;
CPYZIR S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZIR(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZIR Q
;
CPYZEN S LASTLINE=1+$G(LASTLINE),LINESADD=1+$G(LINESADD)+$O(VAFZEN(""),-1)
MERGE @XMITARRY@(LASTLINE)=VAFZEN Q
;
;
;-- Line tags for deleting variables used to build HL7 segments
;
DELEVN K VAFEVN Q
;
DELPID K VAFPID Q
;
DELPD1 K VAFPD1 Q
;
DELPV1 K VAFPV1 Q
;
DELROL K VAFROL Q
;
DELOBX K VAFOBX Q
;
DELZPD K VAFZPD Q
;
DELZSP K VAFZSP Q
;
DELZEL K VAFZEL Q
;
DELZCT K VAFZCT Q
;
DELZEM K VAFZEM Q
;
DELZFF K VAFZFF Q
;
DELZIR K VAFZIR Q
;
DELZEN K VAFZEN Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCMSG3 5766 printed Apr 09, 2024@21:49:39 Page 2
VAFCMSG3 ;ALB/JRP,PKE-Message Builder Utilities ; 4/26/03 12:05pm
+1 ;;5.3;Registration;**91,209,149,261,307,494,484,477**;Aug 13, 1993
+2 ;
+3 ;-- Line tags for building HL7 segments
+4 ;
+5 ; Standardized variable names:
+6 ; All HL7 variables created by calling INIT^HLFNC2() must exist
+7 ; DFN - Pointer to entry in PATIENT file (#2)
+8 ; EVNTHL7 - HL7 ADT event being transmitted
+9 ; EVNTDATE - Date/time event occurred (FileMan format)
+10 ; EVNTINFO() - Array containing extra info needed to build segments
+11 ; (full global reference)
+12 ; VAFSTR - String of fields to put into segment separated by commas
+13 ;
BLDEVN SET VAFEVN=$$EN^VAFHLEVN(EVNTHL7,EVNTDATE,VAFSTR,HL("Q"),HL("FS"))
+1 ;Manually add event type code (seq #1)
+2 SET $PIECE(VAFEVN,HL("FS"),2)=EVNTHL7
+3 ;Manually add event reason code (seq #4)
+4 SET $PIECE(VAFEVN,HL("FS"),5)=$GET(@EVNTINFO@("REASON",1))
+5 ;If applicable, manually add operator (seq #5)
+6 if ($DATA(@EVNTINFO@("USER")))
SET $PIECE(VAFEVN,HL("FS"),6)=@EVNTINFO@("USER")
+7 QUIT
BLDPID ;
+1 SET VAFPID=$$EN^VAFCPID(DFN,VAFSTR)
+2 ;CHECK IF PATIENT HAS AN ICN IF NOT A28
+3 IF $PIECE(VAFPID,HL("FS"),3)=HLQ&(EVNTHL7'="A28")
Begin DoDot:1
+4 IF $TEXT(GETICN^MPIF001)']""
QUIT
+5 ; returns National ICN -- don't create local ICN
+6 NEW ICN
SET ICN=$$GETICN^MPIF001(DFN)
+7 IF +ICN>0
SET $PIECE(VAFPID,HL("FS"),3)=ICN
End DoDot:1
+8 QUIT
+9 ;
BLDPD1 ;
+1 IF EVNTHL7="A28"
Begin DoDot:1
+2 NEW CHANGE,CMOR
+3 NEW X
SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
+4 IF +$$GETVCCI^MPIF001(DFN)'>0
Begin DoDot:2
+5 ;S CMOR=$P($$SITE^VASITE(),"^")
+6 ;S CHANGE=$$CHANGE^MPIF001(DFN,CMOR)
+7 ;I +CHANGE<0 D START^RGHLLOG(),EXC^RGHLLOG(211,"Trouble updating CMOR while building A28 msg in VAFCMSG3 for DFN = "_DFN),STOP^RGHLLOG()
End DoDot:2
End DoDot:1
+8 SET VAFPD1=$$EN^VAFHLPD1(DFN)
+9 ;
BLDPV1 IF EVNTHL7="A28"
SET VAFPV1="PV1"_HL("FS")_1
+1 IF '$TEST
SET VAFPV1=$$EN^VAFCPV1(DFN)
QUIT
+2 ;
BLDROL ;
+1 IF $GET(@EVNTINFO@("SERVER PROTOCOL"))'="VAFC ADT-A08-SDAM SERVER"
+2 IF $TEST
IF $GET(^DPT(DFN,.1))]""
Begin DoDot:1
+3 DO BLDROL^VAFCROL("VAFROL",DFN,EVNTDATE,VAFSTR,$GET(@EVNTINFO@("PIVOT")))
End DoDot:1
+4 QUIT
+5 ;
BLDOBX ;
+1 ;**477
NEW VAFARRY
SET SECINFO=$$EN^VAFHLZSN(DFN)
IF $PIECE(SECINFO,"^",2)'=""
IF $PIECE(SECINFO,"^",2)'?.2""""
Begin DoDot:1
+2 SET VAFARRY(2)="CE"
+3 SET $PIECE(VAFARRY(3),$EXTRACT(HL("ECH"),1),2)="SECURITY LEVEL"
+4 SET VAFARRY(5)=$PIECE(SECINFO,"^",2)
+5 SET VAFARRY(11)="F"
+6 SET VAFARRY(14)=$$FMDATE^HLFNC($PIECE(SECINFO,"^",4))
+7 SET VAFARRY(16)=$PIECE(SECINFO,"^",3)
End DoDot:1
+8 ;
+9 SET VAFOBX=$$EN^VAFHLOBX(.VAFARRY)
KILL SECINFO
+10 QUIT
+11 ;
BLDZPD SET VAFZPD=$$EN^VAFHLZPD(DFN,VAFSTR)
QUIT
+1 ;
BLDZSP SET VAFZSP=$$EN^VAFHLZSP(DFN)
QUIT
+1 ;
BLDZEL SET VAFZEL=$$EN^VAFHLZEL(DFN,VAFSTR,1)
QUIT
+1 ;
BLDZCT SET VAFZCT=$$EN^VAFHLZCT(DFN,VAFSTR)
QUIT
+1 ;
BLDZEM SET VAFZEM=$$EN^VAFHLZEM(DFN,VAFSTR)
QUIT
+1 ;
BLDZFF SET VAFZFF="ZFF"_HL("FS")_2_HL("FS")
+1 SET VAFZFF=VAFZFF_$PIECE($GET(^VAT(391.71,+$GET(@EVNTINFO@("PIVOT")),2)),U)
+2 QUIT
+3 ;
BLDZIR KILL DGREL,DGINC,DGINR,DGDEP
+1 DO ALL^DGMTU21(DFN,"V",EVNTDATE,"R")
+2 SET VAFZIR=$$EN^VAFHLZIR(+$GET(DGINR("V")),VAFSTR,1)
+3 KILL DGREL,DGINC,DGINR,DGDEP
+4 QUIT
+5 ;
BLDZEN SET VAFZEN=$$EN^VAFHLZEN(DFN,VAFSTR,1,HL("Q"),HL("FS"))
QUIT
+1 ;
+2 ;
+3 ;-- Line tags for copying HL7 segments into HL7 message
+4 ;
+5 ; Standardized variable names:
+6 ; Variables set by BLDxxx tags
+7 ; XMITARRY - Array to build HL7 message into (full global reference)
+8 ; LASTLINE - Last line number used in HL7 message
+9 ; - This value will be incremented appropriately
+10 ; LINESADD - Total number of lines added to HL7 message
+11 ; - This value will be incremented appropriately
+12 ;
CPYEVN NEW I
+1 SET LASTLINE=1+$GET(LASTLINE)
+2 SET @XMITARRY@(LASTLINE)=VAFEVN
+3 SET LINESADD=1+$GET(LINESADD)
+4 SET I=""
+5 FOR
SET I=+$ORDER(VAFEVN(I))
if ('I)
QUIT
Begin DoDot:1
+6 SET @XMITARRY@(LASTLINE,I)=VAFEVN(I)
+7 SET LINESADD=LINESADD+1
End DoDot:1
+8 QUIT
+9 ; rev $o is # lines from array
CPYPID SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFPID(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFPID
QUIT
+2 ;
CPYPD1 SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFPD1(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFPD1
QUIT
+2 ;
CPYPV1 SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFPV1(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFPV1
QUIT
+2 ;
CPYROL NEW I,J,K
+1 SET I=""
+2 FOR K=1:1
SET I=+$ORDER(VAFROL(I))
if ('I)
QUIT
Begin DoDot:1
+3 SET J=""
+4 FOR
SET J=$ORDER(VAFROL(I,J))
if (J="")
QUIT
Begin DoDot:2
+5 if ('J)
SET @XMITARRY@(LASTLINE+K)=VAFROL(I,J)
+6 if (J)
SET @XMITARRY@(LASTLINE+K,J)=VAFROL(I,J)
+7 SET LINESADD=1+$GET(LINESADD)
End DoDot:2
End DoDot:1
+8 SET LASTLINE=LASTLINE+K-1
+9 QUIT
+10 ;
CPYOBX SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFOBX(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFOBX
QUIT
+2 ;
CPYZPD SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZPD(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZPD
QUIT
+2 ;
CPYZSP SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZSP(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZSP
QUIT
+2 ;
CPYZEL SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZEL(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZEL
QUIT
+2 ;
CPYZCT SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZCT(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZCT
QUIT
+2 ;
CPYZEM SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZEM(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZEM
QUIT
+2 ;
CPYZFF SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZFF(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZFF
QUIT
+2 ;
CPYZIR SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZIR(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZIR
QUIT
+2 ;
CPYZEN SET LASTLINE=1+$GET(LASTLINE)
SET LINESADD=1+$GET(LINESADD)+$ORDER(VAFZEN(""),-1)
+1 MERGE @XMITARRY@(LASTLINE)=VAFZEN
QUIT
+2 ;
+3 ;
+4 ;-- Line tags for deleting variables used to build HL7 segments
+5 ;
DELEVN KILL VAFEVN
QUIT
+1 ;
DELPID KILL VAFPID
QUIT
+1 ;
DELPD1 KILL VAFPD1
QUIT
+1 ;
DELPV1 KILL VAFPV1
QUIT
+1 ;
DELROL KILL VAFROL
QUIT
+1 ;
DELOBX KILL VAFOBX
QUIT
+1 ;
DELZPD KILL VAFZPD
QUIT
+1 ;
DELZSP KILL VAFZSP
QUIT
+1 ;
DELZEL KILL VAFZEL
QUIT
+1 ;
DELZCT KILL VAFZCT
QUIT
+1 ;
DELZEM KILL VAFZEM
QUIT
+1 ;
DELZFF KILL VAFZFF
QUIT
+1 ;
DELZIR KILL VAFZIR
QUIT
+1 ;
DELZEN KILL VAFZEN
QUIT
+1 ;
