source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCCVPCE.m@ 1071

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
2 ;;5.3;Scheduling;**211**;Aug 13, 1993
3 ;
4DATA2PCE(SDOE,SCCONS,SCCVEVT,SCOEP,SCDTM,SCDA,SCEST) ; -- send data to pce
5 ;Input:
6 ; SCOE Internal entry # of encounter
7 ; SCCONS Array containing constant data for the conversion ...
8 ; needed for reconvert to work properly
9 ; ("PKG") = Scheduling package pointer
10 ; ("SRCE") = source name for the conversion
11 ; SCCVEVT 1 for estimate, 2 for convert
12 ; SCOEP Parent encounter [optional]
13 ; SCDTM Date/time of add/edit entry if no encounter [optional]
14 ; SCDA 'CS' entry ien if add/edit, no encounter [optional]
15 ;Output:
16 ; SCEST Variable of '^' pieces that contain # of entries to be added:
17 ; # providers^# diagnoses^# procedures
18 ;
19 N PXKNOEVT,SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SCPCE,SDOEC,SCE,SCERRM
20 ;
21 K ^TMP("PXK-SD",$J),^TMP("PXK",$J)
22 S SCEST=0
23 ; -- gather needed data
24 S SDOE0=$G(^SCE(SDOE,0))
25 ;
26 I SCCVEVT G DATAQ:SDOE0=""
27 ;
28 S SDVST=$S('$G(SCOEP):+$P(SDOE0,U,5),1:+$P($G(^SCE(SCOEP,0)),U,5))
29 ;
30 I SCCVEVT G DATAQ:'SDVST
31 ;
32 ; -- if child visit and has v-file data quit
33 I $S('$G(SCOEP):0,1:$O(^AUPNVCPT("AD",SDVST,0))!($O(^AUPNVPRV("AD",SDVST,0)))!($O(^AUPNVPOV("AD",SDVST,0)))) G DATAQ
34 ;
35 ; -- Get data from encounter for providers, diagnoses, classifications
36 D SET(SDOE,"SDPRV",409.44)
37 D SET(SDOE,"SDIAG",409.43)
38 D SET(SDOE,"SDCLS",409.42)
39 ; -- Get data for procedures
40 I '$G(SCOEP) D ; look for parents only so data not duplicated
41 . D PROC(SDOE,+$G(SCDTM),+$G(SCDA),SCCVEVT,"SDPROC")
42 ;
43 ; -- Build PCE data array
44 D BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SCPCE","^TMP(""PXK-SD"","_$J_")",+$P(SDOE0,U,2),SDVST)
45 ;
46 ; For Estimate, count # of cpt's, dx's, providers to be added
47 I 'SCCVEVT D G DATAQ ;Estimate exits here
48 . S SCEST=+$O(^TMP("PXK-SD",$J,"PRV",""),-1)_U_+$O(SCPCE("DX/PL",""),-1)_U_+$O(SCPCE("PROCEDURE",""),-1)
49 ;
50 ; -- Call PCE APIs to file additional data
51 S PXKNOEVT=1 ;Needed to keep sched events from being fired off by PCE
52 ;
53 I $D(SCPCE),$$DATA2PCE^PXAPI("SCPCE",$G(SCCONS("PKG")),$G(SCCONS("SRCE")),SDVST)<0 D
54 . N Z,Z0,Z1,SCTEXT,SCX
55 . S (Z,Z1)=0
56 . F S Z=$O(SCPCE("DIERR",Z)) Q:'Z S Z0=0 F S Z0=$O(SCPCE("DIERR",Z,"TEXT",Z0)) Q:'Z0 S SCTEXT=$TR(SCPCE("DIERR",Z,"TEXT",Z0)," ") I SCTEXT'="" D
57 .. S:Z0=1&(Z>1) Z1=Z1+1,SCERRM(Z1)=" -----"
58 .. I SCTEXT["SCPCE.." S SCX=$P(SCTEXT,"=",2) D Q
59 ... I SCTEXT["DX/PL" S Z1=Z1+1,SCERRM(Z1)=" DIAGNOSIS "_+SCX_" ("_$S($D(^ICD9(+SCX,0)):$P(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED" D SETERR^SCCVZZ("POV",SCOE,+SCX,$G(SCLOG))
60 ... I SCTEXT["PROCEDURE" S Z1=Z1+1,SCERRM(Z1)=" PROCEDURE "_+SCX_" ("_$S($D(^ICPT(+SCX,0)):$P(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED" D SETERR^SCCVZZ("CPT",SCOE,+SCX,$G(SCLOG))
61 .. S Z1=Z1+1,SCERRM(Z1)=SCPCE("DIERR",Z,"TEXT",Z0)
62 . S SCE("DFN")=$P(SDOE0,U,2),SCE("ENC")=SDOE,SCE("VSIT")=SDVST,SCE("DATE")=+SDOE0
63 . I $O(SCERRM("")) D
64 .. D LOGERR^SCCVLOG1($G(SCLOG),.SCERRM,.SCE,.SCCVERRH)
65 .. I '$G(SCLOG) D
66 ... N Z,Z0 S Z=0,Z0=$O(SCERRMSG(""),-1) F S Z=$O(SCERRM(Z)) Q:'Z S Z0=Z0+1,SCERRMSG(Z0)=SCERRM(Z,0)
67 ;
68 I $D(^TMP("PXK-SD",$J)) D ;Convert providers
69 . N Z,Z0,Z1,SCTEXT,SCX
70 . M ^TMP("PXK",$J)=^TMP("PXK-SD",$J)
71 . K ^TMP("PXK-SD",$J)
72 . D EN1^PXKMAIN
73 . S Z="PXKERROR(""PRV"")",Z1=0
74 . F S Z=$G(@Z) Q:Z'["PXKERROR(""PRV""" S SCTEXT=$G(@Z) D
75 .. S SCX=+$G(^TMP("PXK",$J,"PRV",+$QS(Z,2),0,"AFTER"))
76 .. S Z1=Z1+1 S:Z1>1 SCERRM(Z1)=" -----",Z1=Z1+1
77 .. S SCERRM(Z1)=" PROVIDER ERROR "_SCX_" ("_$S($D(^VA(200,SCX,0)):$P(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED"
78 .. S Z1=Z1+1,SCERRM(Z1)=" "_SCTEXT
79 .. D SETERR^SCCVZZ("PRV",SCOE,SCX,$G(SCLOG))
80 . K ^TMP("PXK",$J),PXKERROR
81 ;
82DATAQ Q
83 ;
84BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA,SPDATA,DFN,SDVST) ; -- bld pce data arrays
85 N X,SDI,SDIEN,SDCNT,SDSEQ,SCSRCE
86 S SCSRCE=$$SOURCE^PXAPI($G(SCCONS("SRCE")))
87 S SDI=0 F S SDI=$O(@SDCLASS@(SDI)) Q:'SDI D
88 . S X=@SDCLASS@(SDI)
89 . S @SDATA@("ENCOUNTER",1,$P("AO^IR^SC^EC",U,+X))=$P(X,U,3)
90 ;
91 ; -- set dx info
92 I $O(@SDDX@(0)) D
93 . S (SDCNT,SDIEN)=0
94 . F S SDIEN=$O(@SDDX@(SDIEN)) Q:'SDIEN D
95 . . S X=@SDDX@(SDIEN)
96 . . S SDCNT=SDCNT+1
97 . . S @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
98 ;
99 ; -- set cpt info
100 I $O(@SDCPT@(0)) D
101 . ; -- count times performed
102 . N SDX
103 . S (SDCNT,SDSEQ)=0
104 . F S SDSEQ=$O(@SDCPT@(SDSEQ)) Q:'SDSEQ D
105 . . S SDIEN=@SDCPT@(SDSEQ)
106 . . S SDX(+SDIEN)=$G(SDX(+SDIEN))+1
107 . ;
108 . ; -- build nodes
109 . S (SDCNT,SDIEN)=0
110 . F S SDIEN=$O(SDX(SDIEN)) Q:'SDIEN D
111 . . S X=SDX(SDIEN)
112 . . S SDCNT=SDCNT+1
113 . . S @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
114 . . S @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
115 ;
116 ; -- build prov pce data array to be stuffed
117 ; Must be separate to call EN1^PXKMAIN to add so no check for prov class
118 ;
119 I $O(@SDPROV@(0)) D
120 . K @SPDATA
121 . S (SDCNT,SDIEN)=0
122 . S @SPDATA@("VST",1,0,"AFTER")=$G(^AUPNVSIT(SDVST,0))
123 . S @SPDATA@("VST",1,0,"BEFORE")=@SPDATA@("VST",1,0,"AFTER")
124 . F S SDIEN=$O(@SDPROV@(SDIEN)) Q:'SDIEN D
125 . . S X=@SDPROV@(SDIEN),SDCNT=SDCNT+1
126 . . S @SPDATA@("SOR")=SCSRCE
127 . . S @SPDATA@("PRV",SDCNT,0,"BEFORE")=""
128 . . S @SPDATA@("PRV",SDCNT,0,"AFTER")=+X_U_DFN_U_SDVST_U_$S(SDCNT=1:"P",1:"S")_U
129 . . S @SPDATA@("PRV",SDCNT,812,"BEFORE")=""
130 . . S @SPDATA@("PRV",SDCNT,812,"AFTER")=U_$G(SCCONS("PKG"))_U_$$SOURCE^PXAPI($G(SCCONS("SRCE")))
131 . . S @SPDATA@("PRV",SDCNT,"IEN")=""
132 . . S @SPDATA@("VST",SDCNT,"IEN")=SDVST
133 ;
134 Q
135 ;
136BUILDQ Q
137 ;
138SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
139 ; Input -- SDOE Outpatient Encounter IEN
140 ; Output -- ARRAY Provider or dx Array Subscripted by ien
141 ;
142 N SDIEN,SDDUP,SDCNT
143 S SDIEN=0,SDCNT=0
144 F S SDIEN=$O(^SDD(FILE,"OE",SDOE,SDIEN)) Q:'SDIEN D
145 . S X=$G(^SDD(FILE,SDIEN,0)) Q:X=""!$S(FILE'[".42":$D(SDDUP(+X)),1:0)
146 . S SDCNT=SDCNT+1,@ARRAY@(SDCNT)=X,SDDUP(+X)=""
147 Q
148 ;
149PROC(SDOE,SCDTM,SCDA,SCCVEVT,SCDXARRY) ;
150 ; SDOE = encounter ien
151 ; SCDTM = if estimating and no enctr, dt/tm of the new encounter [opt]
152 ; SCDA = if estimating and no enctr, 'CS' node entry [opt]
153 ; SCCVEVT = conversion event
154 ; SCDXARRY = name of array to return
155 N CNT,SDOEC
156 S CNT=0,SDOE=+$G(SDOE),SDOEC=""
157 I 'SDOE,'SCDTM,'SCDA G PROCQ
158 ;
159 ; - Use parent encounter for standalone add/edit
160 ; - There may be no encounter yet if we're just estimating
161 ; ... it will never get here without an encounter if converting
162 I $S('SDOE:1,1:$P($G(^SCE(SDOE,0)),"^",8)=2) D G PROCQ
163 . D GETPROC(.CNT,SDOE,$G(SCDTM),$G(SCDA),SCDXARRY) Q
164 ;
165 ;- Use child encounter(s) for appointment and disposition
166 F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC I $P($G(^SCE(SDOEC,0)),"^",8)=2 D GETPROC(.CNT,SDOEC,"","",SCDXARRY)
167 ;
168 ;- Array of procedures
169PROCQ S @SCDXARRY@(0)=CNT
170 Q
171 ;
172 ;
173GETPROC(CNT,ENC,SDVDT,EXTREF,SCDXARRY) ;Get procedures from Scheduling Visits file
174 ;
175 ;
176 N DATE,DFN,I,NODE,PRNODE,SUB
177 ;
178 I ENC D ;Find 'CS' node from encounter data
179 . S NODE=$G(^SCE(ENC,0)),DATE=+$P(NODE,"^"),DFN=+$P(NODE,"^",2),EXTREF=$P(NODE,"^",9)
180 . S DATE=$P(DATE,"."),SDVDT=$$SDVIEN^SCCVU(DFN,DATE)
181 Q:'$G(SDVDT)
182 F I=1:1:$L(EXTREF,":") D ;Should not have > 1 for dates < 10-1-96
183 . S SUB=+$P(EXTREF,":",I)
184 . I '$D(^SDV(SDVDT,"CS",SUB,0)) Q
185 . I ENC,$P(^SDV(SDVDT,"CS",SUB,0),U,8)'=ENC Q
186 . S CNT=$G(CNT)+$$PRNODE(SDVDT,SUB,SCDXARRY)
187 Q
188 ;
189PRNODE(SDVDT,SUB,SCDXARRY) ; Extract data for procs from SDV's 'PR' node
190 ; SDVDT -- SDV entry ien
191 ; SUB -- 'CS' node entry ien
192 ; SCDXARRY -- the name of the array to return for the entry
193 ; SCDXARRY(0)= the total # of procedure codes
194 ; SCDXARRY(CPT code) = the total # of a particular CPT code
195 N PRNODE,PCNT,X
196 S PCNT=0
197 S PRNODE=$G(^SDV(+SDVDT,"CS",+SUB,"PR"))
198 I $L(PRNODE,"^")<1 G PRQ
199 F X=1:1:$L(PRNODE,"^") I $P(PRNODE,"^",X)'="" S PCNT=PCNT+1,@SCDXARRY@($O(@SCDXARRY@(""),-1)+1)=$P(PRNODE,"^",X)
200PRQ Q $G(PCNT)
201 ;
Note: See TracBrowser for help on using the repository browser.