- SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
- ;;5.3;Scheduling;**211**;Aug 13, 1993
- ;
- 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)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVPCE 8008 printed Jan 18, 2025@03:40:08 Page 2
- SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
- +1 ;;5.3;Scheduling;**211**;Aug 13, 1993
- +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 ;