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

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1VAFHCPV ;ALB/CM OUTPATIENT PV1 SEGMENT ; 22 Jan 2002 10:28 AM
2 ;;5.3;Registration;**91,151,298,494,573**;Aug 13, 1993
3 ;
4 ;This routine generates the Outpatient PV1 segment
5 ;for the Philly project
6 ;
7 ;07/12/00 ACS - Added Facility and Suffix to sequence 39
8 ;
9OPV1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM) ;
10 ;
11 ;B
12 ;DFN - Patient File
13 ;EVENT - event number from pivot file
14 ;EVDT - event date/time in FileMan format
15 ;VPTR - variable pointer
16 ;PSTSR - string of fields (if null - required fields, if "A" - supported
17 ;fields, or string of fields separated by commas")
18 ;PNUM - ID # - always 1 (optional)
19 ;
20 N RESULT
21 S RESULT="PV1"_HLFS_HLFS_"O"
22 I '$D(DFN)!('$D(EVENT))!('$D(EVDT))!('$D(VPTR)) Q RESULT
23 I $D(EVENT) I EVENT'="" S NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
24 I $D(EVENT) I EVENT="" K EVENT
25 I '$D(EVENT) S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR),EVENT=$P(NODE,":")
26 I EVENT<1 Q RESULT
27 S NODE=$P(NODE,":",2)
28 I NODE="" S REMOVED="Y"
29 ;
30EN ;
31 N PV1,EVTY,LOC,LOOP,HLD,PIVOT,QUOT
32 S QUOT=""""""
33 I '$D(PNUM) S PNUM=1
34 I $G(PSTR)="A" S PSTR=",2,3,7,10,44,45,50,"
35 I $G(PSTR)'="" S PSTR=","_PSTR_","
36 I $G(PSTR)="" S PSTR=""
37 I +PSTR=-1 Q RESULT
38 I $D(REMOVED) S $P(PV1,HLFS,50)=+EVENT,$P(PV1,HLFS,2)="O",$P(PV1,HLFS,1)=PNUM,PV1="PV1"_HLFS_PV1 K REMOVED Q PV1
39 S (PIVOT,PV1)="",EVTY="O",LOOP=0
40 ; Empty PV1 segment:
41 S $P(PV1,HLFS,2)="O"
42 ;
43 ;F S LOOP=LOOP+1,HLD=$P(PSTR,",",LOOP) Q:HLD="" D
44 ;.I HLD=2 S $P(PV1,HLFS,2)=EVTY Q
45 ;.I HLD=3 S $P(PV1,HLFS,3)=$$CLINIC(NODE) Q
46 ;.I HLD=7 S $P(PV1,HLFS,7)=$$OUTPRO(NODE) Q
47 ;.;patient type for v2.3
48 ;.I HLD=18 DO Q
49 ;. .I +$G(^DPT(DFN,"TYPE")) DO
50 ;. . .S $P(RESULT,HLFS,18)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
51 ;. .E S $P(RESULT,HLFS,18)=HLQ
52 ;.I HLD=44 S $P(PV1,HLFS,44)=$$HLDATE^HLFNC(EVDT) Q
53 ;.I HLD=50 S $P(PV1,HLFS,50)=EVENT Q
54 ;
55 I PSTR[",3," S $P(PV1,HLFS,3)=$$CLINIC(NODE)
56 I PSTR[",7," S $P(PV1,HLFS,7)=$$OUTPRO(NODE)
57 ;.;patient type for v2.3
58 I PSTR[18 DO
59 .I +$G(^DPT(DFN,"TYPE")) DO
60 . .S $P(PV1,HLFS,18)=$P($G(^DG(391,+^("TYPE"),0)),"^",1)
61 . .E S $P(PV1,HLFS,18)=HLQ
62 ;
63 ; facility and suffix
64 ;
65 I PSTR[39 D
66 . N VAFACSUF,VAMEDCTR,GLOB
67 . S GLOB="^"_$P(VPTR,";",2)_+VPTR
68 . ;
69 . ; If variable pointer is for patient file:
70 . I GLOB["DPT(" D
71 . . N PATNODE S PATNODE=""
72 . . I '$D(^DPT(DFN)) Q
73 . . F S PATNODE=$O(^DPT(DFN,"DIS",PATNODE)) D Q:PATNODE=""
74 . . . N PATDATA,VAFILE
75 . . . Q:PATNODE=""
76 . . . S PATDATA=$G(^DPT(DFN,"DIS",PATNODE,0))
77 . . . ; Spin through multiple events and get division pointer
78 . . . I EVDT=$P(PATDATA,"^",1) D Q:VAFILE="MATCH"
79 . . . . S VAMEDCTR=$P(PATDATA,"^",4) I VAMEDCTR="" S VAFILE="" Q
80 . . . . ; get facility/suffix from medical center div file
81 . . . . S VAFACSUF=$P($G(^DG(40.8,VAMEDCTR,0)),"^",2)
82 . . . . ; move data into the PV1 segment
83 . . . . S $P(PV1,HLFS,39)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
84 . . . . S VAFILE="MATCH",PATNODE=""
85 . . . . Q
86 . . . Q
87 . . Q
88 . ; If variable pointer is for outpatient encounter file:
89 . I GLOB["^SCE(" D
90 . . N VAFIEN,ENCDATA,ENCDATE
91 . . ; get encounter date and medical center division
92 . . S VAFIEN=+VPTR Q:VAFIEN=""
93 . . I '$D(^SCE(VAFIEN)) Q
94 . . S ENCDATA=$G(^SCE(VAFIEN,0))
95 . . S ENCDATE=$P(ENCDATA,"^",1) Q:ENCDATE=""
96 . . S VAMEDCTR=$P(ENCDATA,"^",11) Q:VAMEDCTR=""
97 . . ; call below returns: inst pointer^inst name^facility w/suffix
98 . . S VAFACSUF=$$SITE^VASITE(ENCDATE,VAMEDCTR)
99 . . S VAFACSUF=$P(VAFACSUF,"^",3)
100 . . ; move data into the PV1 segment
101 . . S $P(PV1,HLFS,39)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
102 . . Q
103 . ;
104 . ; If variable pointer is for patient movement file:
105 . I GLOB["^DGPM(" D
106 . . N VAFIEN,VAFDATE,VAWARD
107 . . ; get movement date and medical center division
108 . . S VAFIEN=+VPTR Q:VAFIEN=""
109 . . I '$D(^DGPM(VAFIEN)) Q
110 . . S VAFDATE=$P($G(^DGPM(VAFIEN,0)),"^",1) Q:VAFDATE=""
111 . . S VAWARD=$P($G(^DGPM(VAFIEN,0)),"^",6) Q:VAWARD=""
112 . . S VAMEDCTR=$P($G(^DIC(42,VAWARD,0)),"^",11) Q:VAMEDCTR=""
113 . . ; call below returns: inst pointer^inst name^facility w/suffix
114 . . S VAFACSUF=$$SITE^VASITE(VAFDATE,VAMEDCTR)
115 . . S VAFACSUF=$P(VAFACSUF,"^",3)
116 . . ; move data into the PV1 segment
117 . . S $P(PV1,HLFS,39)=$S(VAFACSUF]"":VAFACSUF,1:HLQ)
118 . . Q
119 . Q
120 ;
121 I PSTR[44 S $P(PV1,HLFS,44)=$$HLDATE^HLFNC(EVDT)
122 I PSTR[50 S $P(PV1,HLFS,50)=EVENT
123 ;
124 I PV1?1"^"."^" Q RESULT
125 S $P(PV1,HLFS,1)=PNUM,PV1="PV1"_HLFS_PV1
126 K NODE,QUOT
127 Q PV1
128 ;
129CLINIC(ZNODE) ;
130 ;Get clinic for appointments and add/edit stop codes
131 ;
132 N HPTR,HLOC,GLOB,LOC
133 ;
134 ;HPTR=fifth piece in pivot file - Variable pointer
135 ;
136 S (HLOC,LOC)="",HPTR=$P(ZNODE,"^",5),GLOB="^"_$P(HPTR,";",2)_+HPTR_")"
137 I $E(GLOB,1,5)="^DPT(" D
138 .;Patient file, appointment hasn't gotten to outpatient encounter file
139 .S HLOC=$P($G(@GLOB@("S",$P(NODE,"^"),0)),"^")
140 ;
141 I $E(GLOB,1,5)="^SCE(" D
142 .N VAENC0
143 .;Outpatient Encounter file
144 .S HLOC=$$SCE^DGSDU(+$P(GLOB,"^SCE(",2),4,0)
145 ;
146 I HLOC="" Q QUOT
147 ;HLOC is IEN of Hospital Location file
148 S LOC=$P($G(^SC(HLOC,0)),"^")
149 I LOC="" S LOC=QUOT
150 Q LOC
151 ;
152OUTPRO(ZNODE) ;
153 ;
154 N OUTPTR,OPRV,OPTR,FILE,PTR
155 ;
156 ;OUTPTR=fifth piece in pivot file - variable pointer
157 ;
158 S OUTPTR=$P(ZNODE,"^",5),OPTR=+OUTPTR,FILE=$P(OUTPTR,";",2)
159 I OPTR=""!(FILE'="SCE(") Q ""
160 ;
161 ;get primary provider
162 S OPRV=$$GETPRO(OPTR) I OPRV DO Q OPRV
163 . I $P($G(^VA(200,OPRV,0)),"^")]"" DO
164 . . N DGNAME S DGNAME("FILE")=200,DGNAME("IENS")=OPRV,DGNAME("FIELD")=.01
165 . . S OPRV=OPRV_$E(HLECH)_$$HLNAME^XLFNAME(.DGNAME,"S",$E($G(HLECH)))
166 . E S OPRV=QUOT
167 ;
168 Q QUOT
169 ;
170GETPRO(OPTR) ;get first primary provider Returns OPRV or 0
171 N VAENC0,VAEPRV,VAP
172 S VAENC0=$$SCE^DGSDU(OPTR)
173 I OPTR,+VAENC0,$$DATE^SCDXUTL(+VAENC0)
174 E Q 0
175 ;
176 S OPRV=0
177 D GETPRV^SDOE(OPTR,"VAEPRV")
178 S VAP=0 F S VAP=$O(VAEPRV(VAP)) Q:'VAP I $P(VAEPRV(VAP),"^",4)="P" S OPRV=+VAEPRV(VAP)_"^P" Q
179 Q +OPRV
Note: See TracBrowser for help on using the repository browser.