SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21
;
DATA2PCE(SDOE,SCCONS,SCCVEVT,SCOEP,SCDTM,SCDA,SCEST) ; -- send data to pce
;Input:
; SCOE Internal entry # of encounter
; SCCONS Array containing constant data for the conversion ...
; needed for reconvert to work properly
; ("PKG") = Scheduling package pointer
; ("SRCE") = source name for the conversion
; SCCVEVT 1 for estimate, 2 for convert
; SCOEP Parent encounter [optional]
; SCDTM Date/time of add/edit entry if no encounter [optional]
; SCDA 'CS' entry ien if add/edit, no encounter [optional]
;Output:
; SCEST Variable of '^' pieces that contain # of entries to be added:
; # providers^# diagnoses^# procedures
;
N PXKNOEVT,SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SCPCE,SDOEC,SCE,SCERRM
;
K ^TMP("PXK-SD",$J),^TMP("PXK",$J)
S SCEST=0
; -- gather needed data
S SDOE0=$G(^SCE(SDOE,0))
;
I SCCVEVT G DATAQ:SDOE0=""
;
S SDVST=$S('$G(SCOEP):+$P(SDOE0,U,5),1:+$P($G(^SCE(SCOEP,0)),U,5))
;
I SCCVEVT G DATAQ:'SDVST
;
; -- if child visit and has v-file data quit
I $S('$G(SCOEP):0,1:$O(^AUPNVCPT("AD",SDVST,0))!($O(^AUPNVPRV("AD",SDVST,0)))!($O(^AUPNVPOV("AD",SDVST,0)))) G DATAQ
;
; -- Get data from encounter for providers, diagnoses, classifications
D SET(SDOE,"SDPRV",409.44)
D SET(SDOE,"SDIAG",409.43)
D SET(SDOE,"SDCLS",409.42)
; -- Get data for procedures
I '$G(SCOEP) D ; look for parents only so data not duplicated
. D PROC(SDOE,+$G(SCDTM),+$G(SCDA),SCCVEVT,"SDPROC")
;
; -- Build PCE data array
D BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SCPCE","^TMP(""PXK-SD"","_$J_")",+$P(SDOE0,U,2),SDVST)
;
; For Estimate, count # of cpt's, dx's, providers to be added
I 'SCCVEVT D G DATAQ ;Estimate exits here
. S SCEST=+$O(^TMP("PXK-SD",$J,"PRV",""),-1)_U_+$O(SCPCE("DX/PL",""),-1)_U_+$O(SCPCE("PROCEDURE",""),-1)
;
; -- Call PCE APIs to file additional data
S PXKNOEVT=1 ;Needed to keep sched events from being fired off by PCE
;
I $D(SCPCE),$$DATA2PCE^PXAPI("SCPCE",$G(SCCONS("PKG")),$G(SCCONS("SRCE")),SDVST)<0 D
. N Z,Z0,Z1,SCTEXT,SCX
. S (Z,Z1)=0
. 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
.. S:Z0=1&(Z>1) Z1=Z1+1,SCERRM(Z1)=" -----"
.. I SCTEXT["SCPCE.." S SCX=$P(SCTEXT,"=",2) D Q
... 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))
... 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))
.. S Z1=Z1+1,SCERRM(Z1)=SCPCE("DIERR",Z,"TEXT",Z0)
. S SCE("DFN")=$P(SDOE0,U,2),SCE("ENC")=SDOE,SCE("VSIT")=SDVST,SCE("DATE")=+SDOE0
. I $O(SCERRM("")) D
.. D LOGERR^SCCVLOG1($G(SCLOG),.SCERRM,.SCE,.SCCVERRH)
.. I '$G(SCLOG) D
... 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)
;
I $D(^TMP("PXK-SD",$J)) D ;Convert providers
. N Z,Z0,Z1,SCTEXT,SCX
. M ^TMP("PXK",$J)=^TMP("PXK-SD",$J)
. K ^TMP("PXK-SD",$J)
. D EN1^PXKMAIN
. S Z="PXKERROR(""PRV"")",Z1=0
. F S Z=$G(@Z) Q:Z'["PXKERROR(""PRV""" S SCTEXT=$G(@Z) D
.. S SCX=+$G(^TMP("PXK",$J,"PRV",+$QS(Z,2),0,"AFTER"))
.. S Z1=Z1+1 S:Z1>1 SCERRM(Z1)=" -----",Z1=Z1+1
.. S SCERRM(Z1)=" PROVIDER ERROR "_SCX_" ("_$S($D(^VA(200,SCX,0)):$P(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED"
.. S Z1=Z1+1,SCERRM(Z1)=" "_SCTEXT
.. D SETERR^SCCVZZ("PRV",SCOE,SCX,$G(SCLOG))
. K ^TMP("PXK",$J),PXKERROR
;
DATAQ Q
;
BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA,SPDATA,DFN,SDVST) ; -- bld pce data arrays
N X,SDI,SDIEN,SDCNT,SDSEQ,SCSRCE
S SCSRCE=$$SOURCE^PXAPI($G(SCCONS("SRCE")))
S SDI=0 F S SDI=$O(@SDCLASS@(SDI)) Q:'SDI D
. S X=@SDCLASS@(SDI)
. S @SDATA@("ENCOUNTER",1,$P("AO^IR^SC^EC",U,+X))=$P(X,U,3)
;
; -- set dx info
I $O(@SDDX@(0)) D
. S (SDCNT,SDIEN)=0
. F S SDIEN=$O(@SDDX@(SDIEN)) Q:'SDIEN D
. . S X=@SDDX@(SDIEN)
. . S SDCNT=SDCNT+1
. . S @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
;
; -- set cpt info
I $O(@SDCPT@(0)) D
. ; -- count times performed
. N SDX
. S (SDCNT,SDSEQ)=0
. F S SDSEQ=$O(@SDCPT@(SDSEQ)) Q:'SDSEQ D
. . S SDIEN=@SDCPT@(SDSEQ)
. . S SDX(+SDIEN)=$G(SDX(+SDIEN))+1
. ;
. ; -- build nodes
. S (SDCNT,SDIEN)=0
. F S SDIEN=$O(SDX(SDIEN)) Q:'SDIEN D
. . S X=SDX(SDIEN)
. . S SDCNT=SDCNT+1
. . S @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
. . S @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
;
; -- build prov pce data array to be stuffed
; Must be separate to call EN1^PXKMAIN to add so no check for prov class
;
I $O(@SDPROV@(0)) D
. K @SPDATA
. S (SDCNT,SDIEN)=0
. S @SPDATA@("VST",1,0,"AFTER")=$G(^AUPNVSIT(SDVST,0))
. S @SPDATA@("VST",1,0,"BEFORE")=@SPDATA@("VST",1,0,"AFTER")
. F S SDIEN=$O(@SDPROV@(SDIEN)) Q:'SDIEN D
. . S X=@SDPROV@(SDIEN),SDCNT=SDCNT+1
. . S @SPDATA@("SOR")=SCSRCE
. . S @SPDATA@("PRV",SDCNT,0,"BEFORE")=""
. . S @SPDATA@("PRV",SDCNT,0,"AFTER")=+X_U_DFN_U_SDVST_U_$S(SDCNT=1:"P",1:"S")_U
. . S @SPDATA@("PRV",SDCNT,812,"BEFORE")=""
. . S @SPDATA@("PRV",SDCNT,812,"AFTER")=U_$G(SCCONS("PKG"))_U_$$SOURCE^PXAPI($G(SCCONS("SRCE")))
. . S @SPDATA@("PRV",SDCNT,"IEN")=""
. . S @SPDATA@("VST",SDCNT,"IEN")=SDVST
;
Q
;
BUILDQ Q
;
SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
; Input -- SDOE Outpatient Encounter IEN
; Output -- ARRAY Provider or dx Array Subscripted by ien
;
N SDIEN,SDDUP,SDCNT
S SDIEN=0,SDCNT=0
F S SDIEN=$O(^SDD(FILE,"OE",SDOE,SDIEN)) Q:'SDIEN D
. S X=$G(^SDD(FILE,SDIEN,0)) Q:X=""!$S(FILE'[".42":$D(SDDUP(+X)),1:0)
. S SDCNT=SDCNT+1,@ARRAY@(SDCNT)=X,SDDUP(+X)=""
Q
;
PROC(SDOE,SCDTM,SCDA,SCCVEVT,SCDXARRY) ;
; SDOE = encounter ien
; SCDTM = if estimating and no enctr, dt/tm of the new encounter [opt]
; SCDA = if estimating and no enctr, 'CS' node entry [opt]
; SCCVEVT = conversion event
; SCDXARRY = name of array to return
N CNT,SDOEC
S CNT=0,SDOE=+$G(SDOE),SDOEC=""
I 'SDOE,'SCDTM,'SCDA G PROCQ
;
; - Use parent encounter for standalone add/edit
; - There may be no encounter yet if we're just estimating
; ... it will never get here without an encounter if converting
I $S('SDOE:1,1:$P($G(^SCE(SDOE,0)),"^",8)=2) D G PROCQ
. D GETPROC(.CNT,SDOE,$G(SCDTM),$G(SCDA),SCDXARRY) Q
;
;- Use child encounter(s) for appointment and disposition
F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC I $P($G(^SCE(SDOEC,0)),"^",8)=2 D GETPROC(.CNT,SDOEC,"","",SCDXARRY)
;
;- Array of procedures
PROCQ S @SCDXARRY@(0)=CNT
Q
;
;
GETPROC(CNT,ENC,SDVDT,EXTREF,SCDXARRY) ;Get procedures from Scheduling Visits file
;
;
N DATE,DFN,I,NODE,PRNODE,SUB
;
I ENC D ;Find 'CS' node from encounter data
. S NODE=$G(^SCE(ENC,0)),DATE=+$P(NODE,"^"),DFN=+$P(NODE,"^",2),EXTREF=$P(NODE,"^",9)
. S DATE=$P(DATE,"."),SDVDT=$$SDVIEN^SCCVU(DFN,DATE)
Q:'$G(SDVDT)
F I=1:1:$L(EXTREF,":") D ;Should not have > 1 for dates < 10-1-96
. S SUB=+$P(EXTREF,":",I)
. I '$D(^SDV(SDVDT,"CS",SUB,0)) Q
. I ENC,$P(^SDV(SDVDT,"CS",SUB,0),U,8)'=ENC Q
. S CNT=$G(CNT)+$$PRNODE(SDVDT,SUB,SCDXARRY)
Q
;
PRNODE(SDVDT,SUB,SCDXARRY) ; Extract data for procs from SDV's 'PR' node
; SDVDT -- SDV entry ien
; SUB -- 'CS' node entry ien
; SCDXARRY -- the name of the array to return for the entry
; SCDXARRY(0)= the total # of procedure codes
; SCDXARRY(CPT code) = the total # of a particular CPT code
N PRNODE,PCNT,X
S PCNT=0
S PRNODE=$G(^SDV(+SDVDT,"CS",+SUB,"PR"))
I $L(PRNODE,"^")<1 G PRQ
F X=1:1:$L(PRNODE,"^") I $P(PRNODE,"^",X)'="" S PCNT=PCNT+1,@SCDXARRY@($O(@SCDXARRY@(""),-1)+1)=$P(PRNODE,"^",X)
PRQ Q $G(PCNT)
;
SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
+1 ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21
+2 ;
DATA2PCE(SDOE,SCCONS,SCCVEVT,SCOEP,SCDTM,SCDA,SCEST) ; -- send data to pce
+1 ;Input:
+2 ; SCOE Internal entry # of encounter
+3 ; SCCONS Array containing constant data for the conversion ...
+4 ; needed for reconvert to work properly
+5 ; ("PKG") = Scheduling package pointer
+6 ; ("SRCE") = source name for the conversion
+7 ; SCCVEVT 1 for estimate, 2 for convert
+8 ; SCOEP Parent encounter [optional]
+9 ; SCDTM Date/time of add/edit entry if no encounter [optional]
+10 ; SCDA 'CS' entry ien if add/edit, no encounter [optional]
+11 ;Output:
+12 ; SCEST Variable of '^' pieces that contain # of entries to be added:
+13 ; # providers^# diagnoses^# procedures
+14 ;
+15 NEW PXKNOEVT,SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SCPCE,SDOEC,SCE,SCERRM
+16 ;
+17 KILL ^TMP("PXK-SD",$JOB),^TMP("PXK",$JOB)
+18 SET SCEST=0
+19 ; -- gather needed data
+20 SET SDOE0=$GET(^SCE(SDOE,0))
+21 ;
+22 IF SCCVEVT
IF SDOE0=""
GOTO DATAQ
+23 ;
+24 SET SDVST=$SELECT('$GET(SCOEP):+$PIECE(SDOE0,U,5),1:+$PIECE($GET(^SCE(SCOEP,0)),U,5))
+25 ;
+26 IF SCCVEVT
IF 'SDVST
GOTO DATAQ
+27 ;
+28 ; -- if child visit and has v-file data quit
+29 IF $SELECT('$GET(SCOEP):0,1:$ORDER(^AUPNVCPT("AD",SDVST,0))!($ORDER(^AUPNVPRV("AD",SDVST,0)))!($ORDER(^AUPNVPOV("AD",SDVST,0))))
GOTO DATAQ
+30 ;
+31 ; -- Get data from encounter for providers, diagnoses, classifications
+32 DO SET(SDOE,"SDPRV",409.44)
+33 DO SET(SDOE,"SDIAG",409.43)
+34 DO SET(SDOE,"SDCLS",409.42)
+35 ; -- Get data for procedures
+36 ; look for parents only so data not duplicated
IF '$GET(SCOEP)
Begin DoDot:1
+37 DO PROC(SDOE,+$GET(SCDTM),+$GET(SCDA),SCCVEVT,"SDPROC")
End DoDot:1
+38 ;
+39 ; -- Build PCE data array
+40 DO BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SCPCE","^TMP(""PXK-SD"","_$JOB_")",+$PIECE(SDOE0,U,2),SDVST)
+41 ;
+42 ; For Estimate, count # of cpt's, dx's, providers to be added
+43 ;Estimate exits here
IF 'SCCVEVT
Begin DoDot:1
+44 SET SCEST=+$ORDER(^TMP("PXK-SD",$JOB,"PRV",""),-1)_U_+$ORDER(SCPCE("DX/PL",""),-1)_U_+$ORDER(SCPCE("PROCEDURE",""),-1)
End DoDot:1
GOTO DATAQ
+45 ;
+46 ; -- Call PCE APIs to file additional data
+47 ;Needed to keep sched events from being fired off by PCE
SET PXKNOEVT=1
+48 ;
+49 IF $DATA(SCPCE)
IF $$DATA2PCE^PXAPI("SCPCE",$GET(SCCONS("PKG")),$GET(SCCONS("SRCE")),SDVST)<0
Begin DoDot:1
+50 NEW Z,Z0,Z1,SCTEXT,SCX
+51 SET (Z,Z1)=0
+52 FOR
SET Z=$ORDER(SCPCE("DIERR",Z))
IF 'Z
QUIT
SET Z0=0
FOR
SET Z0=$ORDER(SCPCE("DIERR",Z,"TEXT",Z0))
IF 'Z0
QUIT
SET SCTEXT=$TRANSLATE(SCPCE("DIERR",Z,"TEXT",Z0)," ")
IF SCTEXT'=""
Begin DoDot:2
+53 IF Z0=1&(Z>1)
SET Z1=Z1+1
SET SCERRM(Z1)=" -----"
+54 IF SCTEXT["SCPCE.."
SET SCX=$PIECE(SCTEXT,"=",2)
Begin DoDot:3
+55 IF SCTEXT["DX/PL"
SET Z1=Z1+1
SET SCERRM(Z1)=" DIAGNOSIS "_+SCX_" ("_$SELECT($DATA(^ICD9(+SCX,0)):$PIECE(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED"
DO SETERR^SCCVZZ("POV",SCOE,+SCX,$GET(SCLOG))
+56 IF SCTEXT["PROCEDURE"
SET Z1=Z1+1
SET SCERRM(Z1)=" PROCEDURE "_+SCX_" ("_$SELECT($DATA(^ICPT(+SCX,0)):$PIECE(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED"
DO SETERR^SCCVZZ("CPT",SCOE,+SCX,$GET(SCLOG))
End DoDot:3
QUIT
+57 SET Z1=Z1+1
SET SCERRM(Z1)=SCPCE("DIERR",Z,"TEXT",Z0)
End DoDot:2
+58 SET SCE("DFN")=$PIECE(SDOE0,U,2)
SET SCE("ENC")=SDOE
SET SCE("VSIT")=SDVST
SET SCE("DATE")=+SDOE0
+59 IF $ORDER(SCERRM(""))
Begin DoDot:2
+60 DO LOGERR^SCCVLOG1($GET(SCLOG),.SCERRM,.SCE,.SCCVERRH)
+61 IF '$GET(SCLOG)
Begin DoDot:3
+62 NEW Z,Z0
SET Z=0
SET Z0=$ORDER(SCERRMSG(""),-1)
FOR
SET Z=$ORDER(SCERRM(Z))
IF 'Z
QUIT
SET Z0=Z0+1
SET SCERRMSG(Z0)=SCERRM(Z,0)
End DoDot:3
End DoDot:2
End DoDot:1
+63 ;
+64 ;Convert providers
IF $DATA(^TMP("PXK-SD",$JOB))
Begin DoDot:1
+65 NEW Z,Z0,Z1,SCTEXT,SCX
+66 MERGE ^TMP("PXK",$JOB)=^TMP("PXK-SD",$JOB)
+67 KILL ^TMP("PXK-SD",$JOB)
+68 DO EN1^PXKMAIN
+69 SET Z="PXKERROR(""PRV"")"
SET Z1=0
+70 FOR
SET Z=$GET(@Z)
IF Z'["PXKERROR(""PRV"""
QUIT
SET SCTEXT=$GET(@Z)
Begin DoDot:2
+71 SET SCX=+$GET(^TMP("PXK",$JOB,"PRV",+$QSUBSCRIPT(Z,2),0,"AFTER"))
+72 SET Z1=Z1+1
IF Z1>1
SET SCERRM(Z1)=" -----"
SET Z1=Z1+1
+73 SET SCERRM(Z1)=" PROVIDER ERROR "_SCX_" ("_$SELECT($DATA(^VA(200,SCX,0)):$PIECE(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED"
+74 SET Z1=Z1+1
SET SCERRM(Z1)=" "_SCTEXT
+75 DO SETERR^SCCVZZ("PRV",SCOE,SCX,$GET(SCLOG))
End DoDot:2
+76 KILL ^TMP("PXK",$JOB),PXKERROR
End DoDot:1
+77 ;
DATAQ QUIT
+1 ;
BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA,SPDATA,DFN,SDVST) ; -- bld pce data arrays
+1 NEW X,SDI,SDIEN,SDCNT,SDSEQ,SCSRCE
+2 SET SCSRCE=$$SOURCE^PXAPI($GET(SCCONS("SRCE")))
+3 SET SDI=0
FOR
SET SDI=$ORDER(@SDCLASS@(SDI))
IF 'SDI
QUIT
Begin DoDot:1
+4 SET X=@SDCLASS@(SDI)
+5 SET @SDATA@("ENCOUNTER",1,$PIECE("AO^IR^SC^EC",U,+X))=$PIECE(X,U,3)
End DoDot:1
+6 ;
+7 ; -- set dx info
+8 IF $ORDER(@SDDX@(0))
Begin DoDot:1
+9 SET (SDCNT,SDIEN)=0
+10 FOR
SET SDIEN=$ORDER(@SDDX@(SDIEN))
IF 'SDIEN
QUIT
Begin DoDot:2
+11 SET X=@SDDX@(SDIEN)
+12 SET SDCNT=SDCNT+1
+13 SET @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
End DoDot:2
End DoDot:1
+14 ;
+15 ; -- set cpt info
+16 IF $ORDER(@SDCPT@(0))
Begin DoDot:1
+17 ; -- count times performed
+18 NEW SDX
+19 SET (SDCNT,SDSEQ)=0
+20 FOR
SET SDSEQ=$ORDER(@SDCPT@(SDSEQ))
IF 'SDSEQ
QUIT
Begin DoDot:2
+21 SET SDIEN=@SDCPT@(SDSEQ)
+22 SET SDX(+SDIEN)=$GET(SDX(+SDIEN))+1
End DoDot:2
+23 ;
+24 ; -- build nodes
+25 SET (SDCNT,SDIEN)=0
+26 FOR
SET SDIEN=$ORDER(SDX(SDIEN))
IF 'SDIEN
QUIT
Begin DoDot:2
+27 SET X=SDX(SDIEN)
+28 SET SDCNT=SDCNT+1
+29 SET @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
+30 SET @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
End DoDot:2
End DoDot:1
+31 ;
+32 ; -- build prov pce data array to be stuffed
+33 ; Must be separate to call EN1^PXKMAIN to add so no check for prov class
+34 ;
+35 IF $ORDER(@SDPROV@(0))
Begin DoDot:1
+36 KILL @SPDATA
+37 SET (SDCNT,SDIEN)=0
+38 SET @SPDATA@("VST",1,0,"AFTER")=$GET(^AUPNVSIT(SDVST,0))
+39 SET @SPDATA@("VST",1,0,"BEFORE")=@SPDATA@("VST",1,0,"AFTER")
+40 FOR
SET SDIEN=$ORDER(@SDPROV@(SDIEN))
IF 'SDIEN
QUIT
Begin DoDot:2
+41 SET X=@SDPROV@(SDIEN)
SET SDCNT=SDCNT+1
+42 SET @SPDATA@("SOR")=SCSRCE
+43 SET @SPDATA@("PRV",SDCNT,0,"BEFORE")=""
+44 SET @SPDATA@("PRV",SDCNT,0,"AFTER")=+X_U_DFN_U_SDVST_U_$SELECT(SDCNT=1:"P",1:"S")_U
+45 SET @SPDATA@("PRV",SDCNT,812,"BEFORE")=""
+46 SET @SPDATA@("PRV",SDCNT,812,"AFTER")=U_$GET(SCCONS("PKG"))_U_$$SOURCE^PXAPI($GET(SCCONS("SRCE")))
+47 SET @SPDATA@("PRV",SDCNT,"IEN")=""
+48 SET @SPDATA@("VST",SDCNT,"IEN")=SDVST
End DoDot:2
End DoDot:1
+49 ;
+50 QUIT
+51 ;
BUILDQ QUIT
+1 ;
SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
+1 ; Input -- SDOE Outpatient Encounter IEN
+2 ; Output -- ARRAY Provider or dx Array Subscripted by ien
+3 ;
+4 NEW SDIEN,SDDUP,SDCNT
+5 SET SDIEN=0
SET SDCNT=0
+6 FOR
SET SDIEN=$ORDER(^SDD(FILE,"OE",SDOE,SDIEN))
IF 'SDIEN
QUIT
Begin DoDot:1
+7 SET X=$GET(^SDD(FILE,SDIEN,0))
IF X=""!$SELECT(FILE'[".42"
QUIT
+8 SET SDCNT=SDCNT+1
SET @ARRAY@(SDCNT)=X
SET SDDUP(+X)=""
End DoDot:1
+9 QUIT
+10 ;
PROC(SDOE,SCDTM,SCDA,SCCVEVT,SCDXARRY) ;
+1 ; SDOE = encounter ien
+2 ; SCDTM = if estimating and no enctr, dt/tm of the new encounter [opt]
+3 ; SCDA = if estimating and no enctr, 'CS' node entry [opt]
+4 ; SCCVEVT = conversion event
+5 ; SCDXARRY = name of array to return
+6 NEW CNT,SDOEC
+7 SET CNT=0
SET SDOE=+$GET(SDOE)
SET SDOEC=""
+8 IF 'SDOE
IF 'SCDTM
IF 'SCDA
GOTO PROCQ
+9 ;
+10 ; - Use parent encounter for standalone add/edit
+11 ; - There may be no encounter yet if we're just estimating
+12 ; ... it will never get here without an encounter if converting
+13 IF $SELECT('SDOE:1,1:$PIECE($GET(^SCE(SDOE,0)),"^",8)=2)
Begin DoDot:1
+14 DO GETPROC(.CNT,SDOE,$GET(SCDTM),$GET(SCDA),SCDXARRY)
QUIT
End DoDot:1
GOTO PROCQ
+15 ;
+16 ;- Use child encounter(s) for appointment and disposition
+17 FOR
SET SDOEC=$ORDER(^SCE("APAR",SDOE,SDOEC))
IF 'SDOEC
QUIT
IF $PIECE($GET(^SCE(SDOEC,0)),"^",8)=2
DO GETPROC(.CNT,SDOEC,"","",SCDXARRY)
+18 ;
+19 ;- Array of procedures
PROCQ SET @SCDXARRY@(0)=CNT
+1 QUIT
+2 ;
+3 ;
GETPROC(CNT,ENC,SDVDT,EXTREF,SCDXARRY) ;Get procedures from Scheduling Visits file
+1 ;
+2 ;
+3 NEW DATE,DFN,I,NODE,PRNODE,SUB
+4 ;
+5 ;Find 'CS' node from encounter data
IF ENC
Begin DoDot:1
+6 SET NODE=$GET(^SCE(ENC,0))
SET DATE=+$PIECE(NODE,"^")
SET DFN=+$PIECE(NODE,"^",2)
SET EXTREF=$PIECE(NODE,"^",9)
+7 SET DATE=$PIECE(DATE,".")
SET SDVDT=$$SDVIEN^SCCVU(DFN,DATE)
End DoDot:1
+8 IF '$GET(SDVDT)
QUIT
+9 ;Should not have > 1 for dates < 10-1-96
FOR I=1:1:$LENGTH(EXTREF,":")
Begin DoDot:1
+10 SET SUB=+$PIECE(EXTREF,":",I)
+11 IF '$DATA(^SDV(SDVDT,"CS",SUB,0))
QUIT
+12 IF ENC
IF $PIECE(^SDV(SDVDT,"CS",SUB,0),U,8)'=ENC
QUIT
+13 SET CNT=$GET(CNT)+$$PRNODE(SDVDT,SUB,SCDXARRY)
End DoDot:1
+14 QUIT
+15 ;
PRNODE(SDVDT,SUB,SCDXARRY) ; Extract data for procs from SDV's 'PR' node
+1 ; SDVDT -- SDV entry ien
+2 ; SUB -- 'CS' node entry ien
+3 ; SCDXARRY -- the name of the array to return for the entry
+4 ; SCDXARRY(0)= the total # of procedure codes
+5 ; SCDXARRY(CPT code) = the total # of a particular CPT code
+6 NEW PRNODE,PCNT,X
+7 SET PCNT=0
+8 SET PRNODE=$GET(^SDV(+SDVDT,"CS",+SUB,"PR"))
+9 IF $LENGTH(PRNODE,"^")<1
GOTO PRQ
+10 FOR X=1:1:$LENGTH(PRNODE,"^")
IF $PIECE(PRNODE,"^",X)'=""
SET PCNT=PCNT+1
SET @SCDXARRY@($ORDER(@SCDXARRY@(""),-1)+1)=$PIECE(PRNODE,"^",X)
PRQ QUIT $GET(PCNT)
+1 ;
