Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCROL

VAFCROL.m

Go to the documentation of this file.
  1. VAFCROL ;ALB/MRY - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/24/03 9:57 AM
  1. ;;5.3;Registration;**484**;Aug 13, 1993
  1. ;hl7v1.6
  1. ;
  1. ; Called from routines: VAFCA04, VAFCADT2, VAFCMSG3
  1. ;
  1. BLDROL(ROLARRY,DFN,VAFHDT,VAFSTR,PIVOT,IEN) ;
  1. ;Build ROL HL7 segments for a given patient
  1. ;
  1. ;Input : ROLARRY - Array to place output in (full global reference)
  1. ; (Defaults to ^TMP("VAFC ROL SEGMENTS",$J))
  1. ; DFN - Pointer to entry in PATIENT file (#2)
  1. ; VAFHDT - Date/time event occurred (Fileman format)
  1. ; VAFSTR - String of fields to put into segment separated by commas
  1. ; PIVOT - PIVOT entry (file #391.71)
  1. ; IEN - Pointer to entry in PATIENT MOVEMENT file (#405)
  1. ;Output : None
  1. ; ROLARRY(Seq,0) = Fields
  1. ; ROLARRY(Seq,1) = Continuation Fields
  1. ;Note: : ROLARRY will be KILLed on entry
  1. ;
  1. S ROLARRY=$G(ROLARRY)
  1. S:(ROLARRY="") ROLARRY="^TMP(""VAFC ROL SEGMENTS"","_$J_")"
  1. K @ROLARRY
  1. ;
  1. I $G(PIVOT)'>0 Q ; no pivot number
  1. N VAFCPRV,VAFCPAR,VAFCROL,TYPPRV,NODE,PRVNUM
  1. D GETPRV(DFN,VAFHDT,$G(IEN),"VAFCPRV")
  1. S TYPPRV=0
  1. F PRVNUM=1:1 S TYPPRV=$O(VAFCPRV(TYPPRV)) Q:TYPPRV="" D
  1. .K VAFCPAR,VAFCROL
  1. .S NODE=VAFCPRV(TYPPRV)
  1. .S VAFCPAR("PTR200")=+NODE
  1. .S VAFCPAR("INSTID")=PIVOT_"-"_(+NODE)_"*"_PRVNUM
  1. .S VAFCPAR("ACTION")="CO"
  1. .S VAFCPAR("ALTROLE")=$TR(TYPPRV,"12","TA")_$E(HL("ECH"),1)_HL("Q")_$E(HL("ECH"),1)_"VA01"
  1. .S VAFCPAR("CODEONLY")=0
  1. .S VAFCPAR("RDATE")=VAFHDT
  1. .D OUTPAT^VAFHLROL("VAFCPAR","VAFCROL",VAFSTR,HL("FS"),HL("ECH"),HL("Q"),240)
  1. .K VAFCROL("ERROR"),VAFCROL("WARNING")
  1. .M @ROLARRY@(PRVNUM)=VAFCROL
  1. Q
  1. ;
  1. GETPRV(DFN,VAFHDT,IEN,GETPRV) ;
  1. ;Build array; array(1) = attending; array(2) = admitting
  1. N CURRENT,VAROOT,VA200
  1. D KVAR^VADPT
  1. S VAROOT="CURRENT",VAIP("D")=VAFHDT,VA200=1
  1. I $G(IEN)'="" S VAIP("E")=IEN
  1. D IN5^VADPT
  1. ;Build array allowing Attending physician display first in ROL segment
  1. S:$G(CURRENT(7)) @GETPRV@(2)=CURRENT(7) S:$G(CURRENT(18)) @GETPRV@(1)=CURRENT(18)
  1. Q