source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCROL.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1VAFCROL ;ALB/MRY - HL7 ADT MESSAGE BUILDING ROUTINE ; 3/24/03 9:57 AM
2 ;;5.3;Registration;**484**;Aug 13, 1993
3 ;hl7v1.6
4 ;
5 ; Called from routines: VAFCA04, VAFCADT2, VAFCMSG3
6 ;
7BLDROL(ROLARRY,DFN,VAFHDT,VAFSTR,PIVOT,IEN) ;
8 ;Build ROL HL7 segments for a given patient
9 ;
10 ;Input : ROLARRY - Array to place output in (full global reference)
11 ; (Defaults to ^TMP("VAFC ROL SEGMENTS",$J))
12 ; DFN - Pointer to entry in PATIENT file (#2)
13 ; VAFHDT - Date/time event occurred (Fileman format)
14 ; VAFSTR - String of fields to put into segment separated by commas
15 ; PIVOT - PIVOT entry (file #391.71)
16 ; IEN - Pointer to entry in PATIENT MOVEMENT file (#405)
17 ;Output : None
18 ; ROLARRY(Seq,0) = Fields
19 ; ROLARRY(Seq,1) = Continuation Fields
20 ;Note: : ROLARRY will be KILLed on entry
21 ;
22 S ROLARRY=$G(ROLARRY)
23 S:(ROLARRY="") ROLARRY="^TMP(""VAFC ROL SEGMENTS"","_$J_")"
24 K @ROLARRY
25 ;
26 I $G(PIVOT)'>0 Q ; no pivot number
27 N VAFCPRV,VAFCPAR,VAFCROL,TYPPRV,NODE,PRVNUM
28 D GETPRV(DFN,VAFHDT,$G(IEN),"VAFCPRV")
29 S TYPPRV=0
30 F PRVNUM=1:1 S TYPPRV=$O(VAFCPRV(TYPPRV)) Q:TYPPRV="" D
31 .K VAFCPAR,VAFCROL
32 .S NODE=VAFCPRV(TYPPRV)
33 .S VAFCPAR("PTR200")=+NODE
34 .S VAFCPAR("INSTID")=PIVOT_"-"_(+NODE)_"*"_PRVNUM
35 .S VAFCPAR("ACTION")="CO"
36 .S VAFCPAR("ALTROLE")=$TR(TYPPRV,"12","TA")_$E(HL("ECH"),1)_HL("Q")_$E(HL("ECH"),1)_"VA01"
37 .S VAFCPAR("CODEONLY")=0
38 .S VAFCPAR("RDATE")=VAFHDT
39 .D OUTPAT^VAFHLROL("VAFCPAR","VAFCROL",VAFSTR,HL("FS"),HL("ECH"),HL("Q"),240)
40 .K VAFCROL("ERROR"),VAFCROL("WARNING")
41 .M @ROLARRY@(PRVNUM)=VAFCROL
42 Q
43 ;
44GETPRV(DFN,VAFHDT,IEN,GETPRV) ;
45 ;Build array; array(1) = attending; array(2) = admitting
46 N CURRENT,VAROOT,VA200
47 D KVAR^VADPT
48 S VAROOT="CURRENT",VAIP("D")=VAFHDT,VA200=1
49 I $G(IEN)'="" S VAIP("E")=IEN
50 D IN5^VADPT
51 ;Build array allowing Attending physician display first in ROL segment
52 S:$G(CURRENT(7)) @GETPRV@(2)=CURRENT(7) S:$G(CURRENT(18)) @GETPRV@(1)=CURRENT(18)
53 Q
Note: See TracBrowser for help on using the repository browser.