239 lines
9.5 KiB
Mathematica
239 lines
9.5 KiB
Mathematica
SCMCTSK2 ;ALB/JDS - PCMM Inactivation Nightly Job; 18 Apr 2003 9:36 AM ; 10/24/07 12:23pm
|
|
;;5.3;Scheduling;**297,498,527**;AUG 13, 1993;Build 6
|
|
Q
|
|
NIGHT ;nightly task for inact.
|
|
N ENDDT,NOINAC,SIXM,FLGDT,L,PATDT,SEEN
|
|
K ^TMP("SCTSK",$J)
|
|
D DT^DICRW
|
|
S ALPHA=$G(^SCTM(404.44,1,1)),ALPHA=$P(ALPHA,U,8) I ALPHA<DT S ALPHA=0
|
|
;check if this is last day of month
|
|
S X1=DT,X2=1 D C^%DTC I $E(DT,1,5)'=$E(X,1,5) I 'ALPHA D INACTIVE^SCMCTSK1
|
|
S SIXM=$P($G(^SCTM(404.44,1,1)),U,9)
|
|
I SIXM D PRFLAG
|
|
I ALPHA D INACTIVE^SCMCTSK1
|
|
S NOINAC=0 I 'ALPHA S X1=DT,X2=1 D C^%DTC I ($E(DT,6,7)'=15)&($E(DT,1,5)=$E(X,1,5)) S NOINAC=1
|
|
;check for 60 days after flagged for inact.
|
|
S X1=DT,X2=$S(ALPHA:-2,1:-30) D C^%DTC S ENDDT=X
|
|
F DATE=0:0 S DATE=$O(^SCPT(404.43,"AFLG",DATE)) Q:(('DATE)!(('NOINAC)&(DATE>ENDDT))) D
|
|
.F ENTRY=0:0 S ENTRY=$O(^SCPT(404.43,"AFLG",DATE,ENTRY)) Q:'ENTRY D
|
|
..S ZERO=$G(^SCPT(404.43,ENTRY,0)) Q:'ZERO
|
|
..S DFN=+$G(^SCPT(404.42,+ZERO,0)) Q:'DFN
|
|
..S POS=$P(ZERO,U,2)
|
|
..I $P(ZERO,U,4) D UNFLG Q ;already unassigned
|
|
..I $P(ZERO,U,13) S X1=DATE,X2=$S(ALPHA:4,1:90) D C^%DTC S FLGDT=X I FLGDT>DT Q ;ext
|
|
..;check if criteria still met
|
|
..I $P(ZERO,U,17) D UNFLG Q ;Already reactivated
|
|
..;get preceptor position
|
|
..S %DT="",X="T-12M" D ^%DT S STDT=+Y
|
|
..S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS)
|
|
..;see if provider changed
|
|
..I $O(^SCTM(404.52,"AIDT",+PREC,1,-STDT),-1) D UNFLG Q
|
|
..I '$P(ZERO,U,5) D UNFLG Q ;Not primary care
|
|
..S PROV=+$$GETPRTP^SCAPMCU2(POS,DT)
|
|
..S PC=$$GET^XUA4A72(+PROV)
|
|
..S SC297=$$PDAT^SCMCGU("SD*5.3*297")
|
|
..N NEW S NEW=$S($P(ZERO,U,3)<SC297:0,1:1) ;D D^%DTC S NEW=$S(X>330:0,1:1)
|
|
..S X1=DT,X2=SC297 D D^%DTC S SC297=X
|
|
..S X="T-"_$S(SC297>365:"11M",NEW:"11M",1:"23M") D ^%DT S TYDT=+Y D SEEN^SCMCTSK1 I $G(SEEN) D UNFLG Q
|
|
..S X="T-"_$S(SC297>365:"12M",NEW:"12M",1:"24M") D ^%DT S TYDT=+Y D SEEN^SCMCTSK1 I $G(SEEN) D:(DATE>ENDDT) UNFLG Q
|
|
..I ('NOINAC)&(DATE'>ENDDT) D DIS^SCMCTSK1
|
|
..;D MSG(POS,DFN)
|
|
;if 6 months after installation check to flag providers
|
|
I NOINAC D:ALPHA BULL Q
|
|
S PATDT=$$PDAT^SCMCGU("SD*5.3*297") Q:'PATDT
|
|
I SIXM,SIXM'>DT D
|
|
.D PRINAC
|
|
.N FLDA
|
|
.S FLDA(404.44,"1,",19)=""
|
|
.D FILE^DIE("I","FLDA","ERR")
|
|
D BULL
|
|
Q
|
|
UNFLG ;Remove the flag
|
|
N DR,DIE,DA
|
|
S DR=".15///@;.13///@;.12///@",DIE="^SCPT(404.43,",DA=ENTRY D ^DIE
|
|
Q
|
|
PRFLAG ;flag incorrect provider positions
|
|
N POS
|
|
;provider inactivation has run once
|
|
I $P($G(^SCTM(404.44,1,1)),U,11)'="" Q
|
|
D PRFLAG^SCMCTSK3
|
|
Q
|
|
PRINAC ;inactivate flagged providers
|
|
N I,II
|
|
;Provider inactivation run already
|
|
S II=$P($G(^SCTM(404.44,1,1)),U,11) I II'="",II'=DT Q
|
|
F I=0:0 S I=$O(^SCTM(404.52,I)) Q:'I S ZERO=$G(^(I,0)) I $P(ZERO,U,10) D
|
|
.;I $P(ZERO,U,10)>$G(ENDT) Q ;not time yet
|
|
.I $O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999))<(-$P(ZERO,U,2)) Q ;already inactivated
|
|
.;Check if criteria still valid
|
|
.S POS=+ZERO
|
|
.S PROV=+$$GETPRTP^SCAPMCU2(POS,DT)
|
|
.S PC=$$GET^XUA4A72(+PROV)
|
|
.S DR=".091///@",DIE="^SCTM(404.52,",DA=I D ^DIE ;remove flag
|
|
.S ZERO1=$G(^SCTM(404.57,POS,0))
|
|
.I '$D(^SD(403.46,+$P(ZERO1,U,3),2,+PC)) D
|
|
..;enter the inactivation
|
|
..S DIC="^SCTM(404.52,",X=+ZERO,DIC("DR")=".02////"_DT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1"
|
|
..S DIC(0)="LM" D ^DIC
|
|
;only run the inactivation once.
|
|
S $P(^SCTM(404.44,1,1),U,11)=DT
|
|
Q
|
|
FUTAPP(DFN) ;print future appointments
|
|
N TAB,SCDT0 S TAB=$X
|
|
S SCDT=DT+.24
|
|
F S SCDT=$O(^DPT(DFN,"S",SCDT)) Q:'SCDT D
|
|
. S SCDT0=$G(^DPT(DFN,"S",SCDT,0)) Q:$L($P(SCDT0,U,2))
|
|
. S CLIEN=$P(SCDT0,"^") Q:'CLIEN
|
|
. S Y=SCDT X ^DD("DD") W $E(Y_" ",1,17)_" "_$E($P($G(^SC(+CLIEN,0)),U),1,10)
|
|
Q
|
|
GETASC(DATA,ENTRY) ;get associated clinics
|
|
N I,CNT S CNT=0
|
|
F I=0:0 S I=$O(^SCTM(404.57,+$G(ENTRY),5,I)) Q:'I S CNT=CNT+1,DATA(CNT)=I_U_$P($G(^SC(I,0)),U)
|
|
Q
|
|
SETASC(RESULT,DATA) ;set associated clinics
|
|
D SETASC^SCMCTSK7(.RESULT,DATA) Q
|
|
MSG(SCTP,DFN) ;send inactivation message
|
|
;given list of valid positions get current practitioners
|
|
S SCLIST="SCL"
|
|
I "N"'[$P($G(^SCTM(404.57,SCTP,2)),U,9) D
|
|
.S SCOK=$$PRTP^SCAPMC(SCTP,"",.SCLIST,.SCERR)
|
|
.;if preceptor notice turned on for message type
|
|
I +$P($G(^SCTM(404.57,SCTP,2)),U,9) D
|
|
.S SCX=+$$OKPREC2^SCMCLK(SCTP,DT)
|
|
.;if preceptor duz returned, add to array
|
|
.I SCX S @SCLIST@("SCPR",SCX)=""
|
|
N XMY F I=0:0 S I=$O(@SCLIST@("SCPR",I)) Q:'I S XMY(I)=""
|
|
S SCTEXT(1,0)="PATIENT "_$P($G(^DPT(DFN,0)),U)_" has been inactivated from primary care team position "_$P($G(^SCTM(404.57,SCTP,0)),U)
|
|
S XMSUB="Provider's Inactivated Primary Care Patients" D ^XMD
|
|
Q
|
|
BULL ;end of Month Bulletin
|
|
N DISUPNO,BY,DHIT,HEAD
|
|
S DISUPNO=1,L=0
|
|
S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel"
|
|
S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
|
|
K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J),^TMP("SCML",$J)
|
|
S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)=""
|
|
S DIC="^SCPT(404.43,",BY="[SCMC FLAGGED BULLETIN]",FLDS="[SC BULLETIN]",CNT=0
|
|
S:0 FLDS="" S IOP="",DHD="@@",(FR,TO)="" D EN1^DIP
|
|
S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients scheduled for inactivation in next 30 days"
|
|
D LINES(1)
|
|
D ^XMD
|
|
D PRMAIL^SCMCTSK5(1)
|
|
F SCI=0:0 S SCI=$O(^TMP("SCF",$J,SCI)) Q:'SCI D
|
|
.K XMY S XMY(SCI)="" K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J)
|
|
.M ^TMP("SCMC",$J)=^TMP("SCF",$J,SCI)
|
|
.S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel"
|
|
.S XMTEXT="^TMP(""SCMCTXT"",$J,"
|
|
.;D LINES(1) D ^XMD
|
|
S DISUPNO=1
|
|
K ^TMP("SCMC",$J),^TMP("SCMCTXT")
|
|
S XMSUB="Patients With Extended PCMM Inactivation Dates"
|
|
S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
|
|
K ^TMP("SCMC",$J)
|
|
S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)=""
|
|
S DIC="^SCPT(404.43,",BY="[SCMC EXTENDED BULLETIN]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
|
|
S FR=",,,",TO=FR,FLDS="",IOP="",DHD="@@" D EN1^DIP
|
|
S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Extended from inactivation"
|
|
D LINES(3)
|
|
D ^XMD
|
|
D PRMAIL^SCMCTSK5(3)
|
|
S DISUPNO=1
|
|
K ^TMP("SCMC",$J),^TMP("SCMCTXT")
|
|
S XMSUB="Patients Automated Inactivations from Primary Care Panels"
|
|
S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
|
|
K ^TMP("SCMC",$J)
|
|
S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)=""
|
|
S DIC="^SCPT(404.43,",BY="[SCMC INACTIVATED]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
|
|
S FLDS="",IOP="",DHD="@@",FR=",T-30,,",TO=",,,,," D EN1^DIP
|
|
S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Inactivated in last 30 days"
|
|
D LINES(2)
|
|
D ^XMD
|
|
S DISUPNO=1
|
|
D PRMAIL^SCMCTSK5(2)
|
|
K ^TMP("SCMC",$J),^TMP("SCMCTXT")
|
|
I $P($G(^SCTM(404.44,1,1)),U,11)="" D
|
|
. S XMSUB="Primary Care Providers Scheduled for Inactivation"
|
|
. S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
|
|
. K ^TMP("SCMC",$J)
|
|
. S XMTEXT="^TMP(""SCMCTXT"",$J,"
|
|
. S DIC="^SCTM(404.52,",BY="[SC PROVIDER FLAGGED BULLE]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
|
|
. S FLDS="",IOP="",DHD="@@",FR="",TO="" D EN1^DIP
|
|
. D LINES(4)
|
|
. D ^XMD
|
|
. D PRMAIL^SCMCTSK5(4)
|
|
. D BULL^SCMCTSK6
|
|
Q
|
|
LINES(TYPE) ;Lines of Bulletin
|
|
D LINES^SCMCTSK5(TYPE) Q
|
|
ROLE(DATA,INFO) ;SCMC ROLE
|
|
N ROLE,TP,I
|
|
S ROLE=+$G(INFO),TP=+$P($G(INFO),U,2)
|
|
S DATA(0)="0^0^0"
|
|
I 'ROLE Q
|
|
I 'TP Q
|
|
S DATA(0)=+$P($G(^SD(403.46,ROLE,0)),U,3) ;I DATA(0)=3!(DATA(0)=0) S DATA(0)=DATA(0)_"^0^0" Q
|
|
I $$DATES^SCAPMCU1(404.53,+TP) S DATA(0)=DATA(0)_"^1^0" Q
|
|
N PREC S PREC=0
|
|
F I=0:0 S I=$O(^SCTM(404.53,"AD",TP,I)) Q:'I D Q:PREC
|
|
.I $D(^SCTM(404.53,"AD",TP,I,1)) I '$D(^(0)) S PREC=1
|
|
I PREC S DATA(0)=DATA(0)_"^0^1" Q
|
|
S DATA(0)=DATA(0)_"^0^0"
|
|
Q
|
|
INRPT ; REPORT
|
|
N DIOEND,SCDHD
|
|
D PROMPT^SCMCTSK3("**** Date Range Selection ****","DATE PATIENTS INACTIVATED FROM PRIMARY CARE PANELS")
|
|
Q:'$D(^TMP("SC",$J,"XR"))
|
|
D UNASSIGN^SCMCTSK3
|
|
S Q=""""
|
|
S DIC="^SCPT(404.43," ;=0,BY="[SCMC INACTIVATION SORT]"
|
|
D BY
|
|
S (SCDHD,DHD)="AUTOMATED PATIENT INACTIVATION FROM PRIMARY CARE PANELS REPORT"
|
|
S DIOBEG="D DIOBEG^SCMCTSK4"
|
|
S DIOEND="D DIOEND1^SCMCTSK4"
|
|
S FLDS="[SCMC INACTIVATED]" ;,FR="?,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ")
|
|
D EN1^DIP
|
|
Q
|
|
IN30 ;inactivated last month
|
|
D SORT^SCMCTSK1 Q:'X
|
|
S Q=""""
|
|
S DIC="^SCPT(404.43,",L=0,BY="[SCMC INACTIVATION SORT]"
|
|
S DHD="Patients Inactivated from Primary Care Panels in the Past Month"
|
|
S FLDS="[SCMC INACTIVATED]",FR="T-31,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ")
|
|
D EN1^DIP
|
|
Q
|
|
EXRPT ;EXTEND REPORT
|
|
K CLIN,TEAM,INST
|
|
D PROMPT^SCMCTSK3("PCMM Patients with Extended Inactivations","Scheduled Inactivation Date")
|
|
Q:'$D(^TMP("SC",$J,"XR"))
|
|
S Q="""",SORT=1
|
|
D EXTEND^SCMCTSK3
|
|
S DIC="^SCPT(404.43," ;,L=0,BY="[SCMC EXTENDED]"
|
|
S (SCDHD,DHD)="PCMM Patients with extended Inactivations"
|
|
S DIOBEG="D DIOBEG^SCMCTSK4",DIOEND="D EXTKEY^SCMCTSK9"
|
|
D BY
|
|
S FLDS="[SCMC EXTENDED]"
|
|
D EN1^DIP
|
|
Q
|
|
BY N DISPAR
|
|
S BY(0)="^TMP(""SCSORT"",$J)",L(0)=$O(^TMP("SC",$J,"SORT",99),-1)+1,DISPAR(0,1)="+",L=0 I $G(SCDHD)["FTEE" S DISPAR(0,1)="+#" ;BY="@'.01"
|
|
F I=1:1:$L(SORTN,U) S A=$P(SORTN,U,I) Q:'$L(A) S $P(DISPAR(0,I),U,2)=";"_Q_A_": "_Q D
|
|
.I A["PATIENT" I (I>1)!($G(SCDHD)["Patients Scheduled for Inactivation from PC Panel") S $P(DISPAR(0,I),U)="@"
|
|
.I $G(SCDHD)["FTEE" D
|
|
..I A["PROV" S $P(DISPAR(0,I),U)="@"
|
|
..I I>1 I (A["CLI")!(A["POS") S $P(DISPAR(0,I),U)="@"_$P($G(DISPAR(0,I)),U)
|
|
S ZTSAVE("^TMP(""SC"",$J,")="",ZTSAVE("^TMP(""SCSORT"",$J,")=""
|
|
Q
|
|
FLRPT ;FLAGGED REPORT
|
|
D PROMPT^SCMCTSK3("Patients Scheduled for Inactivation from PC Panels","Date Scheduled for Inactivation")
|
|
Q:'$D(^TMP("SC",$J,"XR"))
|
|
D FLAGG^SCMCTSK3
|
|
S Q=""""
|
|
S DIC="^SCPT(404.43,",L=0
|
|
S (SCDHD,DHD)="Patients Scheduled for Inactivation from PC Panels"
|
|
D BY
|
|
S DIOBEG="D DIOBEG^SCMCTSK4"
|
|
S FLDS="[SCMC PENDING UNASSIGN]"
|
|
I $G(DISPAR(0,1))["PATIENT" S FLDS="[SCMC PENDING UNASSIGN PAT]"
|
|
S DIOEND="D DIOEND^SCMCTSK4"
|
|
D EN1^DIP
|