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

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

initial load of WorldVistAEHR

File size: 7.6 KB
RevLine 
[613]1PXAI ;ISL/JVS,ISA/KWP,ESW - PCE DRIVING RTN FOR 'DATA2PCE' API ;6/20/03 11:15am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,74,69,102,111,112,130,164**;Aug 12, 1996
3 Q
4 ;
5 ;+ 1 2 3 4 5 6 7 8 9
6DATA2PCE(PXADATA,PXAPKG,PXASOURC,PXAVISIT,PXAUSER,PXANOT,ERRRET,PXAPREDT,PXAPROB,PXACCNT) ;+API to pass data for add/edit/delete to PCE.
7 ;+ PXADATA (required)
8 ;+ PXAPKG (required)
9 ;+ PXASOURC (required)
10 ;+ PXAVISIT (optional) is pointer to a visit for which the data is to
11 ;+ be related. If the visit is not known then there must be
12 ;+ the ENCOUNTER nodes needed to lookup/create the visit.
13 ;+ PXAUSER (optional) this is a pointer to the user adding the data.
14 ;+ PXANOT (optional) set to 1 if errors are to be displayed to the screen should only be set while writing and debugging the initial code.
15 ;+ ERRRET (optional) passed by reference. If present will return PXKERROR
16 ;+ array elements to the caller.
17 ;+ PXAPREDT (optional) Set to 1 if you want to edit the Primary Provider
18 ;+ only use if for the moment that editing is being done. (dangerous)
19 ;+ PXAPROB (optional) A dotted variable name. When errors and
20 ;+ warnings occur, They will be passed back in the form
21 ;+ of an array with the general description of the problem.
22 ;+ IF ERROR1 - (GENERAL ERRORS)
23 ;+ PXAPROB($J,SUBSCRIPT,"ERROR1",PASSED IN 'FILE',PASSED IN FIELD,
24 ;+ SUBSCRIPT FROM PXADATA)
25 ;+ PXAPROB(23432234,2,"ERROR1","PROVIDER","NAME",7)="BECAUSE..."
26 ;+ IF WARNING2 - (GENERAL WARNINGS)
27 ;+ PXAPROB($J,SUBSCRIPT,"WARNING2",PASSED IN 'FILE',PASSED IN FIELD,
28 ;+ SUBSCRIPT FROM PXADATA)
29 ;+ PXAPROB(23432234,3,"WARNING2","PROCEDURE","QTY",3)="BECAUSE..."
30 ;+ IF WARNING3 - (WARNINGS FOR SERVICE CONNECTION)
31 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"AO")=REASON
32 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"EC")=REASON
33 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"IR")=REASON
34 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"SC")=REASON
35 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"MST")=REASON
36 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"HNC")=REASON
37 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"CV")=REASON
38 ;+ IF ERROR4 - (PROBLEM LIST ERRORS)
39 ;+ PXAPROB($J,6,"ERROR4","PX/DL",(SUBSCRIPT FROM PXADATA))=REASON
40 ;+ PXACCNT (optional) passed by reference. Returns the PFSS Account Reference if known.
41 ; Returned as null if the PFSS Account Reference is located in the Order file(#100)
42 ;+
43 ;+
44 ;+ Returns:
45 ;+ 1 if no errors and process completely
46 ;+ -1 if errors occurred but processed completely as possible
47 ;+ -2 if could not get a visit
48 ;+ -3 if called incorrectly
49 ;
50NEW ;--NEW VARIABLES
51 N NOVSIT,PXAK,DFN,PXAERRF,PXADEC,PXELAP,PXASUB
52 N PATIENT,VALQUIET,PRIMFND
53 K PXAERROR,PXKERROR,PXAERR,PRVDR
54 S PXASUB=0,VALQUIET=1
55 ; needs to look up if not passed.
56 I '$G(PXAVISIT),'$D(@PXADATA@("ENCOUNTER")) Q -3
57 I $G(PXAUSER)<1 S PXAUSER=DUZ
58 ;
59 K ^TMP("PXK",$J),^TMP("DIERR",$J),^TMP("PXAIADDPRV",$J)
60SOR ;--SOURCE
61 I PXAPKG=+PXAPKG S PXAPKG=PXAPKG
62 E S PXAPKG=$$PKG2IEN^VSIT(PXAPKG)
63 I PXASOURC=+PXASOURC S PXASOURC=PXASOURC
64 E S PXASOURC=$$SOURCE^PXAPIUTL(PXASOURC)
65 ;
66 D TMPSOURC^PXAPIUTL(PXASOURC) ;-SAVES & CREATES ^TMP("PXK",$J,"SOR")
67VST ;--VISIT
68 ;--KILL VISIT
69 I $G(PXAVISIT) D VPTR^PXAIVSTV I $G(PXAERRF) D ERR Q -2
70 D VST^PXAIVST
71 I $G(PXAVISIT)<0 Q -2
72 I $G(PXAERRF) D ERR K PXAERR Q -2
73PRV ;--PROVIDER
74 S PATIENT=$P($G(^AUPNVSIT(PXAVISIT,0)),"^",5)
75 S (PXAK,PRIMFND)=0
76 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:(PRIMFND)!(PXAK="") D
77 .I $D(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) D
78 ..S PRIMFND=$G(@PXADATA@("PROVIDER",PXAK,"PRIMARY"))
79 I 'PRIMFND D ;Check for each provider's status as Primary or Secondary
80 .S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D
81 ..I '$D(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) D PROVDRST
82 S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D
83 . D PRV^PXAIPRV I $G(PXAERRF) D ERR
84 K PRI ;--FLAG FOR PRIMARY PROVIDER
85 K PXAERR
86POV ;--DIAGNOSIS
87 S (PXAK,PRIMFND)=0
88 F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:(PXAK="") D Q:PRIMFND
89 .I +$G(@PXADATA@("DX/PL",PXAK,"PRIMARY"))=1 D
90 ..S PRIMFND=$G(@PXADATA@("DX/PL",PXAK,"DIAGNOSIS"))
91 I $D(@PXADATA@("DX/PL")) D POVPRM(PXAVISIT,PRIMFND,.PXADATA) D
92 .S PXAK=0 F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:PXAK="" D
93 ..D POV^PXAIPOV I $G(PXAERRF) D ERR
94 K PXAERR
95 ;
96CPT ;--PROCEDURE
97 S PXAK=0 F S PXAK=$O(@PXADATA@("PROCEDURE",PXAK)) Q:PXAK="" D
98 . D CPT^PXAICPT I $G(PXAERRF) D ERR
99 K PXAERR
100 ;
101EDU ;--PATIENT EDUCATION
102 S PXAK=0 F S PXAK=$O(@PXADATA@("PATIENT ED",PXAK)) Q:PXAK="" D
103 . D EDU^PXAIPED I $G(PXAERRF) D ERR
104 K PXAERR
105 ;
106EXAM ;--EXAMINATION
107 S PXAK=0 F S PXAK=$O(@PXADATA@("EXAM",PXAK)) Q:PXAK="" D
108 . D EXAM^PXAIXAM I $G(PXAERRF) D ERR
109 K PXAERR
110 ;
111HF ;--HEALTH FACTOR
112 S PXAK=0 F S PXAK=$O(@PXADATA@("HEALTH FACTOR",PXAK)) Q:PXAK="" D
113 . D HF^PXAIHF I $G(PXAERRF) D ERR
114 K PXAERR
115 ;
116IMM ;--IMMUNIZATION
117 S PXAK=0 F S PXAK=$O(@PXADATA@("IMMUNIZATION",PXAK)) Q:PXAK="" D
118 . D IMM^PXAIIMM I $G(PXAERRF) D ERR
119 K PXAERR
120 ;
121SKIN ;--SKIN TEST
122 S PXAK=0 F S PXAK=$O(@PXADATA@("SKIN TEST",PXAK)) Q:PXAK="" D
123 . D SKIN^PXAISK I $G(PXAERRF) D ERR
124 K PXAERR
125 ;
126 ;
127 D OTHER^PXAIPRV
128 ;
129 ;
130 I $D(^TMP("PXK",$J)) D
131 . D EN1^PXKMAIN
132 . M ERRRET=PXKERROR
133 . D PRIM^PXAIPRV K PRVDR
134 . D EVENT^PXKMAIN
135 S PXACCNT=$P($G(^AUPNVSIT(PXAVISIT,0)),"^",26) ;PX*1.0*164 ;Sets the PFSS Account Reference, if any
136 K ^TMP("PXK",$J),PXAERR,PXKERROR
137 Q $S($G(PXAERRF):-1,1:1)
138 ;
139 ;
140EXIT ;--EXIT AND CLEAN UP
141 D EVENT^PXKMAIN
142 K ^TMP("PXK",$J),PRVDR
143 K PXAERR
144 Q
145 ;-----------------SUBROUTINES-----------------------
146ERR ;
147 ;
148 ;
149 I '$D(PXADI("DIALOG")) Q
150 N NODE,SCREEN
151 S PXAERR(1)=$G(PXADATA),PXAERR(2)=$G(PXAPKG),PXAERR(3)=$G(PXASOURC)
152 S PXAERR(4)=$G(PXAVISIT),PXAERR(5)=$G(PXAUSER)_" "_$P($G(^VA(200,PXAUSER,0)),"^",1)
153 I $G(PXANOT)=1 D EXTERNAL
154 E D INTERNAL
155 D ARRAY^PXAICPTV
156 K PXADI("DIALOG")
157 Q
158 ;
159EXTERNAL ;---SEND ERRORS TO SCREEN
160 W !,"-----------------------------------------------------------------"
161 D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,"","SCREEN","F")
162 D MSG^DIALOG("ESW","",50,10,"SCREEN")
163 ;
164 Q
165INTERNAL ;---SET ERRORS TO GLOBAL ARRAY
166 S NODE=PXADATA
167 D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,.PXAERR,NODE,"F")
168 S NODE=$NA(@PXADATA@("DIERR",$J)) D MSG^DIALOG("ESW","",50,10,NODE)
169 Q
170 ;
171PROVDRST ; Check provider status (Primary or Secondary)
172 N PRVIEN,DETS,DIC,DR,DA,DIQ,PRI,PRVPRIM
173 I $G(PXAK)="" QUIT
174 S PRVIEN=0
175 F S PRVIEN=$O(^AUPNVPRV("AD",PXAVISIT,PRVIEN)) Q:PRVIEN="" D
176 .S DETS=$G(^AUPNVPRV(PRVIEN,0))
177 .I $P(DETS,U)=$G(@PXADATA@("PROVIDER",PXAK,"NAME")) D
178 ..S DIC=9000010.06,DR=.04,DA=PRVIEN
179 ..S DIQ="PRVPRIM(",DIQ(0)="EI" D EN^DIQ1
180 ..S PRI=$E($G(PRVPRIM(9000010.06,DA,DR,"E")),1,1)
181 ..S @PXADATA@("PROVIDER",PXAK,"PRIMARY")=$S(PRI="P":1,1:0)
182 Q
183POVPRM(VISIT,PRIMFND,POVARR) ;
184 N PRVIEN,DETS,STOP,LPXAK,ORDX,NDX,ORDXP
185 S PRVIEN=0
186 ;create array of existing DX; ORDX - pointer to ^ICD9(
187 F S PRVIEN=$O(^AUPNVPOV("AD",PXAVISIT,PRVIEN)) Q:PRVIEN="" D
188 .S DETS=$G(^AUPNVPOV(PRVIEN,0)),ORDX=$P(DETS,U)
189 .S ORDX(ORDX)=PRVIEN I $P(DETS,U,12)="P" S ORDXP(ORDX)=""
190 ; create array of passed DX; NDX - pointer to ^ICD9(
191 S PXAK=0 F S PXAK=$O(@POVARR@("DX/PL",PXAK)) Q:PXAK="" D
192 .S NDX=$G(@POVARR@("DX/PL",PXAK,"DIAGNOSIS")) S NDX(NDX)=PXAK
193 ; force entry of originally primary diagnosis with "S" flag
194 I PRIMFND S ORDX="" D
195 .F S ORDX=$O(ORDXP(ORDX)) Q:ORDX="" I PRIMFND'=ORDX D
196 ..I $D(NDX(ORDX)) S @POVARR@("DX/PL",NDX(ORDX),"PRIMARY")=0
197 ..E D
198 ...S LPXAK=$O(@POVARR@("DX/PL",""),-1)
199 ...S @POVARR@("DX/PL",LPXAK+1,"DIAGNOSIS")=ORDX
200 ...S @POVARR@("DX/PL",LPXAK+1,"PRIMARY")=0
201 Q
202 ;
Note: See TracBrowser for help on using the repository browser.