source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXAPIOE.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1PXAPIOE ;ALB/MJK,ESW - Supported References for ACRP ; 12/5/02 11:27am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**39,73,108**;Aug 12, 1996
3 ;
4 ;
5CPT(PXVIEN,PXERR) ; -- at least one cpt for visit??
6 ;
7 N PXOK
8 S PXOK=0
9 ;
10 ; -- do validation checks
11 IF '$$VALVST(PXVIEN,$G(PXERR)) G CPTQ
12 ;
13 S PXOK=($O(^AUPNVCPT("AD",PXVIEN,0))>0)
14CPTQ Q PXOK
15 ;
16 ;
17GETCPT(PXVIEN,PXCPT,PXERR) ; -- get cpt's for visit
18 ;
19 ; -- do validation checks
20 IF '$$VALVST(PXVIEN,$G(PXERR)) G GETCPTQ
21 ;
22 N I,CNT S (I,CNT)=0 F S I=$O(^AUPNVCPT("AD",PXVIEN,I)) Q:'I D
23 . IF $D(^AUPNVCPT(I,0)) S @PXCPT@(I)=^(0),CNT=CNT+1
24 S @PXCPT=CNT
25GETCPTQ Q
26 ;
27CPTARR(PXVIEN,PXCPT,PXERR) ;+API to return all CPT data for a visit.
28 N IEN,CNT
29 S (IEN,CNT)=0
30 Q:'$$VALVST(PXVIEN,$G(PXERR))
31 F S IEN=$O(^AUPNVCPT("AD",PXVIEN,IEN)) Q:'IEN D
32 . Q:'$D(^AUPNVCPT(IEN))
33 . M @PXCPT@(IEN)=^AUPNVCPT(IEN)
34 . S CNT=CNT+1
35 S @PXCPT=CNT
36 Q
37 ;
38DX(PXVIEN,PXERR) ; -- at least one dx for visit??
39 ;
40 N PXOK
41 S PXOK=0
42 ;
43 ; -- do validation checks
44 IF '$$VALVST(PXVIEN,$G(PXERR)) G DXQ
45 ;
46 S PXOK=($O(^AUPNVPOV("AD",PXVIEN,0))>0)
47DXQ Q PXOK
48 ;
49 ;
50GETDX(PXVIEN,PXDX,PXERR) ; -- get dx's for visit
51 ;
52 ; -- do validation checks
53 IF '$$VALVST(PXVIEN,$G(PXERR)) G GETDXQ
54 ;
55 N I,CNT S (I,CNT)=0 F S I=$O(^AUPNVPOV("AD",PXVIEN,I)) Q:'I D
56 . IF $D(^AUPNVPOV(I,0)) S @PXDX@(I)=^(0),CNT=CNT+1
57 S @PXDX=CNT
58GETDXQ Q
59 ;
60 ;
61PRV(PXVIEN,PXERR) ; -- at least one provider for visit?
62 ;
63 N PXOK
64 S PXOK=0
65 ;
66 ; -- do validation checks
67 IF '$$VALVST(PXVIEN,$G(PXERR)) G PRVQ
68 S PXOK=($O(^AUPNVPRV("AD",PXVIEN,0))>0)
69PRVQ Q PXOK
70 ;
71 ;
72GETPRV(PXVIEN,PXPRV,PXERR) ; -- get provider's for visit;108
73 ;
74 ; -- do validation checks
75 IF '$$VALVST(PXVIEN,$G(PXERR)) G GETPRVQ
76 ;
77 ;PX*1*108;look for duplicates to exclude them
78 N I,CNT,PR,PRS,PS,PP,PRV
79 S (I,CNT)=0 F S I=$O(^AUPNVPRV("AD",PXVIEN,I)) Q:'I D
80 .IF $D(^AUPNVPRV(I,0)) D
81 ..S @PXPRV@(I)=^(0),PR=+@PXPRV@(I),PS=$P(@PXPRV@(I),U,4)
82 ..IF PS="P" D
83 ...I 'CNT S PRV=PR,CNT=1 Q
84 ...I PR=PRV K @PXPRV@(I)
85 ..I PS="S" S PRS(PR,I)=""
86 S PR="" F S PR=$O(PRS(PR)) Q:PR="" S I="" D
87 .F PP=1:1 S I=$O(PRS(PR,I)) Q:I="" D
88 ..I PR=$G(PRV) K @PXPRV@(I) Q
89 ..I PP>1 K @PXPRV@(I)
90 ..E S CNT=CNT+1
91 S @PXPRV=CNT
92GETPRVQ Q
93 ;
94 ;
95VALVST(PXVIEN,PXERR) ; -- validate visit ien input
96 ;
97 ; -- do checks
98 IF PXVIEN,$D(^AUPNVSIT(PXVIEN,0)) Q 1
99 ;
100 ; -- build error msg
101 N PXIN,PXOUT
102 S PXIN("ID")=PXVIEN
103 S PXOUT("ID")=PXVIEN
104 D BLD^DIALOG(1509000.001,.PXIN,.PXOUT,$G(PXERR),"F")
105 Q 0
106 ;
107 ;
108POST ; -- post error action logic
109 ;ZW DO
110 ;ZW DIPI
111 ;ZW DIPE
112 Q
113 ;
114 ;
115PDX(VSTPOV,RANK) ; -- set primary dx for V POV entry
116 ;
117 N VSTRT,VSTSEQ
118 N VSTIEN,X
119 ;
120 ; -- set up structures
121 D INIT(.VSTRT,.VSTSEQ)
122 ;
123 ; -- set up visit
124 S X=$G(^AUPNVPOV(VSTPOV,0))
125 S VSTIEN=+$P(X,U,3)
126 D VNODES(VSTIEN,VSTRT,VSTSEQ)
127 ;
128 ; -- set up dx
129 D DXNODES(VSTPOV,VSTRT,VSTSEQ)
130 S $P(@VSTRT@("POV",1,0,"AFTER"),U,12)=RANK
131 ;
132 ; -- file change and kill
133 D FINAL(VSTRT)
134 Q
135 ;
136 ;
137PCLASS(VSTPRV) ; -- set provider class for V PRV entry
138 ;
139 N VSTRT,VSTSEQ
140 N VSTIEN,X
141 ;
142 ; -- set up structures
143 D INIT(.VSTRT,.VSTSEQ)
144 ;
145 ; -- set up visit
146 S X=$G(^AUPNVPRV(VSTPRV,0))
147 S VSTIEN=+$P(X,U,3)
148 D VNODES(VSTIEN,VSTRT,VSTSEQ)
149 ;
150 ; -- set up provider ; pxkmain will automatically set class
151 D PRVNODES(VSTPRV,VSTRT,VSTSEQ)
152 ;
153 ; -- file change and kill
154 D FINAL(VSTRT)
155 Q
156 ;
157 ;
158INIT(VSTRT,VSTSEQ) ; -- set up structures
159 S VSTRT=$NA(^TMP("PXK",$J))
160 S VSTSEQ=1
161 K @VSTRT
162 S @VSTRT@("SOR")=$O(^PX(839.7,"B","PIMS",0))
163 Q
164 ;
165 ;
166FINAL(VSTRT) ; -- file data and clean up
167 N PXKNOEVT
168 S PXKNOEVT=1
169 D EN1^PXKMAIN
170 K @VSTRT
171 Q
172 ;
173 ;
174VNODES(VSTIEN,VSTRT,VSTSEQ) ; -- get visit nodes
175 N NODE,X
176 S @VSTRT@("VST",VSTSEQ,"IEN")=VSTIEN
177 F NODE=0,21,150,800,811,812 D
178 . S X=$G(^AUPNVSIT(VSTIEN,NODE))
179 . S @VSTRT@("VST",VSTSEQ,NODE,"BEFORE")=X
180 . S @VSTRT@("VST",VSTSEQ,NODE,"AFTER")=X
181 Q
182 ;
183 ;
184DXNODES(VSTPOV,VSTRT,VSTSEQ) ; -- get dx nodes
185 N NODE,X
186 S @VSTRT@("POV",VSTSEQ,"IEN")=VSTPOV
187 F NODE=0,12,812 D
188 . S X=$G(^AUPNVPOV(VSTPOV,NODE))
189 . S @VSTRT@("POV",VSTSEQ,NODE,"BEFORE")=X
190 . S @VSTRT@("POV",VSTSEQ,NODE,"AFTER")=X
191 Q
192 ;
193 ;
194PRVNODES(VSTPRV,VSTRT,VSTSEQ) ; -- get provider nodes
195 N NODE,X
196 S @VSTRT@("PRV",VSTSEQ,"IEN")=VSTPRV
197 F NODE=0,12,812 D
198 . S X=$G(^AUPNVPRV(VSTPRV,NODE))
199 . S @VSTRT@("PRV",VSTSEQ,NODE,"BEFORE")=X
200 . S @VSTRT@("PRV",VSTSEQ,NODE,"AFTER")=X
201 Q
202 ;
Note: See TracBrowser for help on using the repository browser.