- VAFCROL ;ALB/MRY - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/24/03 9:57 AM
- ;;5.3;Registration;**484**;Aug 13, 1993
- ;hl7v1.6
- ;
- ; Called from routines: VAFCA04, VAFCADT2, VAFCMSG3
- ;
- BLDROL(ROLARRY,DFN,VAFHDT,VAFSTR,PIVOT,IEN) ;
- ;Build ROL HL7 segments for a given patient
- ;
- ;Input : ROLARRY - Array to place output in (full global reference)
- ; (Defaults to ^TMP("VAFC ROL SEGMENTS",$J))
- ; DFN - Pointer to entry in PATIENT file (#2)
- ; VAFHDT - Date/time event occurred (Fileman format)
- ; VAFSTR - String of fields to put into segment separated by commas
- ; PIVOT - PIVOT entry (file #391.71)
- ; IEN - Pointer to entry in PATIENT MOVEMENT file (#405)
- ;Output : None
- ; ROLARRY(Seq,0) = Fields
- ; ROLARRY(Seq,1) = Continuation Fields
- ;Note: : ROLARRY will be KILLed on entry
- ;
- S ROLARRY=$G(ROLARRY)
- S:(ROLARRY="") ROLARRY="^TMP(""VAFC ROL SEGMENTS"","_$J_")"
- K @ROLARRY
- ;
- I $G(PIVOT)'>0 Q ; no pivot number
- N VAFCPRV,VAFCPAR,VAFCROL,TYPPRV,NODE,PRVNUM
- D GETPRV(DFN,VAFHDT,$G(IEN),"VAFCPRV")
- S TYPPRV=0
- F PRVNUM=1:1 S TYPPRV=$O(VAFCPRV(TYPPRV)) Q:TYPPRV="" D
- .K VAFCPAR,VAFCROL
- .S NODE=VAFCPRV(TYPPRV)
- .S VAFCPAR("PTR200")=+NODE
- .S VAFCPAR("INSTID")=PIVOT_"-"_(+NODE)_"*"_PRVNUM
- .S VAFCPAR("ACTION")="CO"
- .S VAFCPAR("ALTROLE")=$TR(TYPPRV,"12","TA")_$E(HL("ECH"),1)_HL("Q")_$E(HL("ECH"),1)_"VA01"
- .S VAFCPAR("CODEONLY")=0
- .S VAFCPAR("RDATE")=VAFHDT
- .D OUTPAT^VAFHLROL("VAFCPAR","VAFCROL",VAFSTR,HL("FS"),HL("ECH"),HL("Q"),240)
- .K VAFCROL("ERROR"),VAFCROL("WARNING")
- .M @ROLARRY@(PRVNUM)=VAFCROL
- Q
- ;
- GETPRV(DFN,VAFHDT,IEN,GETPRV) ;
- ;Build array; array(1) = attending; array(2) = admitting
- N CURRENT,VAROOT,VA200
- D KVAR^VADPT
- S VAROOT="CURRENT",VAIP("D")=VAFHDT,VA200=1
- I $G(IEN)'="" S VAIP("E")=IEN
- D IN5^VADPT
- ;Build array allowing Attending physician display first in ROL segment
- S:$G(CURRENT(7)) @GETPRV@(2)=CURRENT(7) S:$G(CURRENT(18)) @GETPRV@(1)=CURRENT(18)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCROL 2071 printed Feb 19, 2025@00:28:23 Page 2
- VAFCROL ;ALB/MRY - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/24/03 9:57 AM
- +1 ;;5.3;Registration;**484**;Aug 13, 1993
- +2 ;hl7v1.6
- +3 ;
- +4 ; Called from routines: VAFCA04, VAFCADT2, VAFCMSG3
- +5 ;
- BLDROL(ROLARRY,DFN,VAFHDT,VAFSTR,PIVOT,IEN) ;
- +1 ;Build ROL HL7 segments for a given patient
- +2 ;
- +3 ;Input : ROLARRY - Array to place output in (full global reference)
- +4 ; (Defaults to ^TMP("VAFC ROL SEGMENTS",$J))
- +5 ; DFN - Pointer to entry in PATIENT file (#2)
- +6 ; VAFHDT - Date/time event occurred (Fileman format)
- +7 ; VAFSTR - String of fields to put into segment separated by commas
- +8 ; PIVOT - PIVOT entry (file #391.71)
- +9 ; IEN - Pointer to entry in PATIENT MOVEMENT file (#405)
- +10 ;Output : None
- +11 ; ROLARRY(Seq,0) = Fields
- +12 ; ROLARRY(Seq,1) = Continuation Fields
- +13 ;Note: : ROLARRY will be KILLed on entry
- +14 ;
- +15 SET ROLARRY=$GET(ROLARRY)
- +16 if (ROLARRY="")
- SET ROLARRY="^TMP(""VAFC ROL SEGMENTS"","_$JOB_")"
- +17 KILL @ROLARRY
- +18 ;
- +19 ; no pivot number
- IF $GET(PIVOT)'>0
- QUIT
- +20 NEW VAFCPRV,VAFCPAR,VAFCROL,TYPPRV,NODE,PRVNUM
- +21 DO GETPRV(DFN,VAFHDT,$GET(IEN),"VAFCPRV")
- +22 SET TYPPRV=0
- +23 FOR PRVNUM=1:1
- SET TYPPRV=$ORDER(VAFCPRV(TYPPRV))
- if TYPPRV=""
- QUIT
- Begin DoDot:1
- +24 KILL VAFCPAR,VAFCROL
- +25 SET NODE=VAFCPRV(TYPPRV)
- +26 SET VAFCPAR("PTR200")=+NODE
- +27 SET VAFCPAR("INSTID")=PIVOT_"-"_(+NODE)_"*"_PRVNUM
- +28 SET VAFCPAR("ACTION")="CO"
- +29 SET VAFCPAR("ALTROLE")=$TRANSLATE(TYPPRV,"12","TA")_$EXTRACT(HL("ECH"),1)_HL("Q")_$EXTRACT(HL("ECH"),1)_"VA01"
- +30 SET VAFCPAR("CODEONLY")=0
- +31 SET VAFCPAR("RDATE")=VAFHDT
- +32 DO OUTPAT^VAFHLROL("VAFCPAR","VAFCROL",VAFSTR,HL("FS"),HL("ECH"),HL("Q"),240)
- +33 KILL VAFCROL("ERROR"),VAFCROL("WARNING")
- +34 MERGE @ROLARRY@(PRVNUM)=VAFCROL
- End DoDot:1
- +35 QUIT
- +36 ;
- GETPRV(DFN,VAFHDT,IEN,GETPRV) ;
- +1 ;Build array; array(1) = attending; array(2) = admitting
- +2 NEW CURRENT,VAROOT,VA200
- +3 DO KVAR^VADPT
- +4 SET VAROOT="CURRENT"
- SET VAIP("D")=VAFHDT
- SET VA200=1
- +5 IF $GET(IEN)'=""
- SET VAIP("E")=IEN
- +6 DO IN5^VADPT
- +7 ;Build array allowing Attending physician display first in ROL segment
- +8 if $GET(CURRENT(7))
- SET @GETPRV@(2)=CURRENT(7)
- if $GET(CURRENT(18))
- SET @GETPRV@(1)=CURRENT(18)
- +9 QUIT