VAFCROL.m

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 ---VAFCROL   2071     printed  Apr 09, 2024@21:54:38                                                                                                                                                                                                     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