| 1 | SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
|
|---|
| 2 | ;;5.3;Scheduling;**211**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | DATA2PCE(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 | ;
|
|---|
| 82 | DATAQ Q
|
|---|
| 83 | ;
|
|---|
| 84 | BUILD(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 | ;
|
|---|
| 136 | BUILDQ Q
|
|---|
| 137 | ;
|
|---|
| 138 | SET(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 | ;
|
|---|
| 149 | PROC(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
|
|---|
| 169 | PROCQ S @SCDXARRY@(0)=CNT
|
|---|
| 170 | Q
|
|---|
| 171 | ;
|
|---|
| 172 | ;
|
|---|
| 173 | GETPROC(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 | ;
|
|---|
| 189 | PRNODE(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)
|
|---|
| 200 | PRQ Q $G(PCNT)
|
|---|
| 201 | ;
|
|---|
