Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCCVPCE

SCCVPCE.m

Go to the documentation of this file.
  1. SCCVPCE ;ALB/TMP - Send data to PCE; [ 01/28/98 10:19 AM ]
  1. ;;5.3;Scheduling;**211**;Aug 13, 1993
  1. ;
  1. DATA2PCE(SDOE,SCCONS,SCCVEVT,SCOEP,SCDTM,SCDA,SCEST) ; -- send data to pce
  1. ;Input:
  1. ; SCOE Internal entry # of encounter
  1. ; SCCONS Array containing constant data for the conversion ...
  1. ; needed for reconvert to work properly
  1. ; ("PKG") = Scheduling package pointer
  1. ; ("SRCE") = source name for the conversion
  1. ; SCCVEVT 1 for estimate, 2 for convert
  1. ; SCOEP Parent encounter [optional]
  1. ; SCDTM Date/time of add/edit entry if no encounter [optional]
  1. ; SCDA 'CS' entry ien if add/edit, no encounter [optional]
  1. ;Output:
  1. ; SCEST Variable of '^' pieces that contain # of entries to be added:
  1. ; # providers^# diagnoses^# procedures
  1. ;
  1. N PXKNOEVT,SDOE0,X,SDVST,SDPRV,SDIAG,SDCLS,SDPROC,SCPCE,SDOEC,SCE,SCERRM
  1. ;
  1. K ^TMP("PXK-SD",$J),^TMP("PXK",$J)
  1. S SCEST=0
  1. ; -- gather needed data
  1. S SDOE0=$G(^SCE(SDOE,0))
  1. ;
  1. I SCCVEVT G DATAQ:SDOE0=""
  1. ;
  1. S SDVST=$S('$G(SCOEP):+$P(SDOE0,U,5),1:+$P($G(^SCE(SCOEP,0)),U,5))
  1. ;
  1. I SCCVEVT G DATAQ:'SDVST
  1. ;
  1. ; -- if child visit and has v-file data quit
  1. I $S('$G(SCOEP):0,1:$O(^AUPNVCPT("AD",SDVST,0))!($O(^AUPNVPRV("AD",SDVST,0)))!($O(^AUPNVPOV("AD",SDVST,0)))) G DATAQ
  1. ;
  1. ; -- Get data from encounter for providers, diagnoses, classifications
  1. D SET(SDOE,"SDPRV",409.44)
  1. D SET(SDOE,"SDIAG",409.43)
  1. D SET(SDOE,"SDCLS",409.42)
  1. ; -- Get data for procedures
  1. I '$G(SCOEP) D ; look for parents only so data not duplicated
  1. . D PROC(SDOE,+$G(SCDTM),+$G(SCDA),SCCVEVT,"SDPROC")
  1. ;
  1. ; -- Build PCE data array
  1. D BUILD("SDPRV","SDIAG","SDCLS","SDPROC","SCPCE","^TMP(""PXK-SD"","_$J_")",+$P(SDOE0,U,2),SDVST)
  1. ;
  1. ; For Estimate, count # of cpt's, dx's, providers to be added
  1. I 'SCCVEVT D G DATAQ ;Estimate exits here
  1. . S SCEST=+$O(^TMP("PXK-SD",$J,"PRV",""),-1)_U_+$O(SCPCE("DX/PL",""),-1)_U_+$O(SCPCE("PROCEDURE",""),-1)
  1. ;
  1. ; -- Call PCE APIs to file additional data
  1. S PXKNOEVT=1 ;Needed to keep sched events from being fired off by PCE
  1. ;
  1. I $D(SCPCE),$$DATA2PCE^PXAPI("SCPCE",$G(SCCONS("PKG")),$G(SCCONS("SRCE")),SDVST)<0 D
  1. . N Z,Z0,Z1,SCTEXT,SCX
  1. . S (Z,Z1)=0
  1. . 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
  1. .. S:Z0=1&(Z>1) Z1=Z1+1,SCERRM(Z1)=" -----"
  1. .. I SCTEXT["SCPCE.." S SCX=$P(SCTEXT,"=",2) D Q
  1. ... 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))
  1. ... 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))
  1. .. S Z1=Z1+1,SCERRM(Z1)=SCPCE("DIERR",Z,"TEXT",Z0)
  1. . S SCE("DFN")=$P(SDOE0,U,2),SCE("ENC")=SDOE,SCE("VSIT")=SDVST,SCE("DATE")=+SDOE0
  1. . I $O(SCERRM("")) D
  1. .. D LOGERR^SCCVLOG1($G(SCLOG),.SCERRM,.SCE,.SCCVERRH)
  1. .. I '$G(SCLOG) D
  1. ... 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)
  1. ;
  1. I $D(^TMP("PXK-SD",$J)) D ;Convert providers
  1. . N Z,Z0,Z1,SCTEXT,SCX
  1. . M ^TMP("PXK",$J)=^TMP("PXK-SD",$J)
  1. . K ^TMP("PXK-SD",$J)
  1. . D EN1^PXKMAIN
  1. . S Z="PXKERROR(""PRV"")",Z1=0
  1. . F S Z=$G(@Z) Q:Z'["PXKERROR(""PRV""" S SCTEXT=$G(@Z) D
  1. .. S SCX=+$G(^TMP("PXK",$J,"PRV",+$QS(Z,2),0,"AFTER"))
  1. .. S Z1=Z1+1 S:Z1>1 SCERRM(Z1)=" -----",Z1=Z1+1
  1. .. S SCERRM(Z1)=" PROVIDER ERROR "_SCX_" ("_$S($D(^VA(200,SCX,0)):$P(^(0),U),1:"UNDEFINED")_") WAS NOT CONVERTED"
  1. .. S Z1=Z1+1,SCERRM(Z1)=" "_SCTEXT
  1. .. D SETERR^SCCVZZ("PRV",SCOE,SCX,$G(SCLOG))
  1. . K ^TMP("PXK",$J),PXKERROR
  1. ;
  1. DATAQ Q
  1. ;
  1. BUILD(SDPROV,SDDX,SDCLASS,SDCPT,SDATA,SPDATA,DFN,SDVST) ; -- bld pce data arrays
  1. N X,SDI,SDIEN,SDCNT,SDSEQ,SCSRCE
  1. S SCSRCE=$$SOURCE^PXAPI($G(SCCONS("SRCE")))
  1. S SDI=0 F S SDI=$O(@SDCLASS@(SDI)) Q:'SDI D
  1. . S X=@SDCLASS@(SDI)
  1. . S @SDATA@("ENCOUNTER",1,$P("AO^IR^SC^EC",U,+X))=$P(X,U,3)
  1. ;
  1. ; -- set dx info
  1. I $O(@SDDX@(0)) D
  1. . S (SDCNT,SDIEN)=0
  1. . F S SDIEN=$O(@SDDX@(SDIEN)) Q:'SDIEN D
  1. . . S X=@SDDX@(SDIEN)
  1. . . S SDCNT=SDCNT+1
  1. . . S @SDATA@("DX/PL",SDCNT,"DIAGNOSIS")=+X
  1. ;
  1. ; -- set cpt info
  1. I $O(@SDCPT@(0)) D
  1. . ; -- count times performed
  1. . N SDX
  1. . S (SDCNT,SDSEQ)=0
  1. . F S SDSEQ=$O(@SDCPT@(SDSEQ)) Q:'SDSEQ D
  1. . . S SDIEN=@SDCPT@(SDSEQ)
  1. . . S SDX(+SDIEN)=$G(SDX(+SDIEN))+1
  1. . ;
  1. . ; -- build nodes
  1. . S (SDCNT,SDIEN)=0
  1. . F S SDIEN=$O(SDX(SDIEN)) Q:'SDIEN D
  1. . . S X=SDX(SDIEN)
  1. . . S SDCNT=SDCNT+1
  1. . . S @SDATA@("PROCEDURE",SDCNT,"PROCEDURE")=SDIEN
  1. . . S @SDATA@("PROCEDURE",SDCNT,"QTY")=+X
  1. ;
  1. ; -- build prov pce data array to be stuffed
  1. ; Must be separate to call EN1^PXKMAIN to add so no check for prov class
  1. ;
  1. I $O(@SDPROV@(0)) D
  1. . K @SPDATA
  1. . S (SDCNT,SDIEN)=0
  1. . S @SPDATA@("VST",1,0,"AFTER")=$G(^AUPNVSIT(SDVST,0))
  1. . S @SPDATA@("VST",1,0,"BEFORE")=@SPDATA@("VST",1,0,"AFTER")
  1. . F S SDIEN=$O(@SDPROV@(SDIEN)) Q:'SDIEN D
  1. . . S X=@SDPROV@(SDIEN),SDCNT=SDCNT+1
  1. . . S @SPDATA@("SOR")=SCSRCE
  1. . . S @SPDATA@("PRV",SDCNT,0,"BEFORE")=""
  1. . . S @SPDATA@("PRV",SDCNT,0,"AFTER")=+X_U_DFN_U_SDVST_U_$S(SDCNT=1:"P",1:"S")_U
  1. . . S @SPDATA@("PRV",SDCNT,812,"BEFORE")=""
  1. . . S @SPDATA@("PRV",SDCNT,812,"AFTER")=U_$G(SCCONS("PKG"))_U_$$SOURCE^PXAPI($G(SCCONS("SRCE")))
  1. . . S @SPDATA@("PRV",SDCNT,"IEN")=""
  1. . . S @SPDATA@("VST",SDCNT,"IEN")=SDVST
  1. ;
  1. Q
  1. ;
  1. BUILDQ Q
  1. ;
  1. SET(SDOE,ARRAY,FILE) ;Set-up Array for Outpatient Encounter
  1. ; Input -- SDOE Outpatient Encounter IEN
  1. ; Output -- ARRAY Provider or dx Array Subscripted by ien
  1. ;
  1. N SDIEN,SDDUP,SDCNT
  1. S SDIEN=0,SDCNT=0
  1. F S SDIEN=$O(^SDD(FILE,"OE",SDOE,SDIEN)) Q:'SDIEN D
  1. . S X=$G(^SDD(FILE,SDIEN,0)) Q:X=""!$S(FILE'[".42":$D(SDDUP(+X)),1:0)
  1. . S SDCNT=SDCNT+1,@ARRAY@(SDCNT)=X,SDDUP(+X)=""
  1. Q
  1. ;
  1. PROC(SDOE,SCDTM,SCDA,SCCVEVT,SCDXARRY) ;
  1. ; SDOE = encounter ien
  1. ; SCDTM = if estimating and no enctr, dt/tm of the new encounter [opt]
  1. ; SCDA = if estimating and no enctr, 'CS' node entry [opt]
  1. ; SCCVEVT = conversion event
  1. ; SCDXARRY = name of array to return
  1. N CNT,SDOEC
  1. S CNT=0,SDOE=+$G(SDOE),SDOEC=""
  1. I 'SDOE,'SCDTM,'SCDA G PROCQ
  1. ;
  1. ; - Use parent encounter for standalone add/edit
  1. ; - There may be no encounter yet if we're just estimating
  1. ; ... it will never get here without an encounter if converting
  1. I $S('SDOE:1,1:$P($G(^SCE(SDOE,0)),"^",8)=2) D G PROCQ
  1. . D GETPROC(.CNT,SDOE,$G(SCDTM),$G(SCDA),SCDXARRY) Q
  1. ;
  1. ;- Use child encounter(s) for appointment and disposition
  1. F S SDOEC=$O(^SCE("APAR",SDOE,SDOEC)) Q:'SDOEC I $P($G(^SCE(SDOEC,0)),"^",8)=2 D GETPROC(.CNT,SDOEC,"","",SCDXARRY)
  1. ;
  1. ;- Array of procedures
  1. PROCQ S @SCDXARRY@(0)=CNT
  1. Q
  1. ;
  1. ;
  1. GETPROC(CNT,ENC,SDVDT,EXTREF,SCDXARRY) ;Get procedures from Scheduling Visits file
  1. ;
  1. ;
  1. N DATE,DFN,I,NODE,PRNODE,SUB
  1. ;
  1. I ENC D ;Find 'CS' node from encounter data
  1. . S NODE=$G(^SCE(ENC,0)),DATE=+$P(NODE,"^"),DFN=+$P(NODE,"^",2),EXTREF=$P(NODE,"^",9)
  1. . S DATE=$P(DATE,"."),SDVDT=$$SDVIEN^SCCVU(DFN,DATE)
  1. Q:'$G(SDVDT)
  1. F I=1:1:$L(EXTREF,":") D ;Should not have > 1 for dates < 10-1-96
  1. . S SUB=+$P(EXTREF,":",I)
  1. . I '$D(^SDV(SDVDT,"CS",SUB,0)) Q
  1. . I ENC,$P(^SDV(SDVDT,"CS",SUB,0),U,8)'=ENC Q
  1. . S CNT=$G(CNT)+$$PRNODE(SDVDT,SUB,SCDXARRY)
  1. Q
  1. ;
  1. PRNODE(SDVDT,SUB,SCDXARRY) ; Extract data for procs from SDV's 'PR' node
  1. ; SDVDT -- SDV entry ien
  1. ; SUB -- 'CS' node entry ien
  1. ; SCDXARRY -- the name of the array to return for the entry
  1. ; SCDXARRY(0)= the total # of procedure codes
  1. ; SCDXARRY(CPT code) = the total # of a particular CPT code
  1. N PRNODE,PCNT,X
  1. S PCNT=0
  1. S PRNODE=$G(^SDV(+SDVDT,"CS",+SUB,"PR"))
  1. I $L(PRNODE,"^")<1 G PRQ
  1. F X=1:1:$L(PRNODE,"^") I $P(PRNODE,"^",X)'="" S PCNT=PCNT+1,@SCDXARRY@($O(@SCDXARRY@(""),-1)+1)=$P(PRNODE,"^",X)
  1. PRQ Q $G(PCNT)
  1. ;