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

SCMCTSK2.m

Go to the documentation of this file. 
  1. SCMCTSK2 ;ALB/JDS - PCMM Inactivation Nightly Job; 18 Apr 2003  9:36 AM ; 10/24/07 12:23pm  ; Compiled November 21, 2007 13:32:47  ; 9/22/09 8:43am
  1.  ;;5.3;PIMS;**297,498,527,499,532,1015,1016**;JUN 30, 2012;Build 20
  1.  Q
  1. NIGHT ;
  1.  N ENDDT,NOINAC,SIXM,FLGDT,L,PATDT,SEEN,SDDT,LDOM
  1.  D DT^DICRW S SDDT=$P($G(^XTMP("SCMCTSK2-"_DT,0)),U,2)
  1.  I SDDT="" S SDDT=DT
  1.  S ALPHA=$G(^SCTM(404.44,1,1)),ALPHA=$P(ALPHA,U,8) I ALPHA<SDDT S ALPHA=0
  1.  ;if 'ALPHA NOINAC=1 except 15th and the Last Day of a Month (LDoM)
  1.  ;inact only on 15th and on LDoM
  1.  S (NOINAC,LDOM)=0
  1.  S X1=SDDT,X2=1 D C^%DTC
  1.  I ($E(SDDT,1,5)'=$E(X,1,5)) S LDOM=1
  1.  I 'ALPHA D
  1.  .I ($E(SDDT,6,7)'=15)&('LDOM) S NOINAC=1
  1.  .D INACTIVE^SCMCTSK1
  1.  S SIXM=$P($G(^SCTM(404.44,1,1)),U,9)
  1.  I SIXM!(LDOM) D PRFLAG
  1.  I ALPHA D INACTIVE^SCMCTSK1
  1.  ;determine ENDDT-Inactn Date-30 days if flagged today
  1.  F DATE=0:0 S DATE=$O(^SCPT(404.43,"AFLG",DATE)) Q:'DATE  D
  1.  .F ENTRY=0:0 S ENTRY=$O(^SCPT(404.43,"AFLG",DATE,ENTRY)) Q:'ENTRY  D
  1.  ..S ZERO=$G(^SCPT(404.43,ENTRY,0)) Q:'ZERO
  1.  ..S DFN=+$G(^SCPT(404.42,+ZERO,0)) Q:'DFN
  1.  ..S POS=$P(ZERO,U,2)
  1.  ..I $P(ZERO,U,4) D UNFLG Q  ;unass.
  1.  ..S X1=DATE,X2=$S(ALPHA:+2,1:+30) D C^%DTC S ENDDT=X
  1.  ..N SDASS S SDASS=$P(ZERO,U,3)
  1.  ..;N-new or E-stbl.
  1.  ..;assig >12 months since flagging, not NEW, E-stbl)
  1.  ..N NEW
  1.  ..S NEW=0 S X1=DATE,X2=SDASS D ^%DTC I X<365 S NEW=1
  1.  ..I NEW S %DT="",X="T-12M" D ^%DT S STDT=+Y D
  1.  ...S X1=STDT,X2=-7 D C^%DTC S TYDT=X
  1.  ..I 'NEW S %DT="",X="T-24M" D ^%DT S STDT=+Y D
  1.  ...S X1=STDT,X2=-7 D C^%DTC S TYDT=X
  1.  ..;
  1.  ..;I $P(ZERO,U,17) D UNFLG Q  ;react.
  1.  ..;get prec 
  1.  ..;S %DT="",X="T-12M" D ^%DT S STDT=+Y
  1.  ..;S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS)
  1.  ..I '$P(ZERO,U,5) D UNFLG Q  ;Not PC
  1.  ..D SEEN^SCMCTSK1(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN)
  1.  ..;S PC=$$GET^XUA4A72(+PROV)
  1.  ..I SEEN D UNFLG Q
  1.  ..I $P(ZERO,U,13) S X1=DATE,X2=$S(ALPHA:4,1:90) D C^%DTC S FLGDT=X I FLGDT>SDDT Q  ;do not inactivate yet; extended
  1.  ..I ('NOINAC)&(SDDT'<ENDDT) D DIS^SCMCTSK1
  1.  ;flag prov 6m after install sd/297
  1.  I NOINAC D:ALPHA BULL I '$D(^SCPT(404.43,"AFLG",SDDT)) K ^TMP($J,"SCMCTSK2") Q
  1.  ;flag prov 6m after install sd/297
  1.  ;I SIXM&(SIXM'>SDDT)!LDOM D
  1.  I LDOM!ALPHA D
  1.  .D PRINAC
  1.  .;N FLDA
  1.  .;S FLDA(404.44,"1,",19)=""
  1.  .;D FILE^DIE("I","FLDA","ERR")
  1.  D BULL K ^TMP($J,"SCMCTSK2")
  1.  Q
  1. UNFLG ;Unflagging
  1.  N DR,DIE,DA
  1.  S DR=".15///@;.13///@;.12///@",DIE="^SCPT(404.43,",DA=ENTRY D ^DIE
  1.  Q
  1. PRFLAG ;flag incorrect provider pos
  1.  N POS
  1.  ;prov inact. has run once
  1.  ;I $P($G(^SCTM(404.44,1,1)),U,11)'="" Q
  1.  D PRFLAG^SCMCTSK3
  1.  Q
  1. PRINAC ;inact. flagged providers
  1.  N I,II
  1.  ;Prov inact. run already
  1.  I $G(SDDT)="" S SDDT=DT
  1.  ;S II=$P($G(^SCTM(404.44,1,1)),U,11) I II'="",II'=SDDT Q
  1.  F I=0:0 S I=$O(^SCTM(404.52,I)) Q:'I  S ZERO=$G(^(I,0)) I $P(ZERO,U,10) D
  1.  .S ZEROIEN=I
  1.  .;uncomment next line for testing only bpfo/swo 11.19.2008
  1.  .;S X1=$P(ZERO,U,10),X2=$S(ALPHA:2,1:30) D C^%DTC I SDDT<X Q  ;not time yet
  1.  .;I $P(ZERO,U,10)>$G(ENDDT) Q   ;not time yet
  1.  .I +$$EN^SCMCTSKI(1)<SDDT Q
  1.  .I $O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999))<(-$P(ZERO,U,2)) Q   ;inactivated
  1.  .;Check valid criteria
  1.  .S POS=+ZERO
  1.  .S PROV=+$$GETPRTP^SCAPMCU2(POS,SDDT)
  1.  .S PC=$$GET^XUA4A72(+PROV)
  1.  .S DR=".091///@",DIE="^SCTM(404.52,",DA=ZEROIEN D ^DIE  ;remove flag
  1.  .S ZERO1=$G(^SCTM(404.57,POS,0))
  1.  .I '$D(^SD(403.46,+$P(ZERO1,U,3),2,+PC)) D
  1.  ..;inactivation
  1.  ..K DO
  1.  ..S DIC="^SCTM(404.52,",X=+ZERO,DIC("DR")=".02////"_DT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1"
  1.  ..S DIC(0)="Z" D FILE^DICN
  1.  ..;S DIE="^SCTM(404.52,",DA=+ZERO,DR=".02////"_SDDT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1"
  1.  ..;D ^DIE
  1.  ;only run inact. once
  1.  S $P(^SCTM(404.44,1,1),U,11)=SDDT
  1.  Q
  1. FUTAPP(DFN) ;print future appts
  1.  N TAB,SCDT0,SCARRAY,SCDTMP S TAB=$X
  1.  I $G(SDDT)="" S SDDT=DT
  1.  S SCDT=SDDT+.24
  1.  S SCARRAY(1)=SCDT  ;date/time filter
  1.  S SCARRAY(4)=DFN  ;patient filter
  1.  S SCARRAY("SORT")="P"  ;sort filter
  1.  S SCARRAY("FLDS")="1;2;3"
  1.  I ($$SDAPI^SDAMA301(.SCARRAY)>0) D
  1.  .S SCDTMP=0 F  S SCDTMP=$O(^TMP($J,"SDAMA301",DFN,SCDTMP)) Q:'SCDTMP  D
  1.  ..S SCDT0=$G(^TMP($J,"SDAMA301",DFN,SCDTMP)) Q:($P($P(SCDT0,U,3),U)="R")
  1.  ..S Y=SCDTMP X ^DD("DD") W $E(Y_" ",1,17)_" "_$E($P($P(SCDT0,U,2),";",2),1,10)
  1.  Q
  1. GETASC(DATA,ENTRY) ;get assoc. clinics
  1.  N I,CNT S CNT=0
  1.  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)
  1.  Q
  1. SETASC(RESULT,DATA) ;set assoc. clinics
  1.  D SETASC^SCMCTSK7(.RESULT,DATA) Q
  1. MSG(SCTP,DFN) ;send inact. message
  1.  ;given valid positions get current practitioners
  1.  S SCLIST="SCL"
  1.  I $G(SDDT)="" S SDDT=DT
  1.  I "N"'[$P($G(^SCTM(404.57,SCTP,2)),U,9) D
  1.  .S SCOK=$$PRTP^SCAPMC(SCTP,"",.SCLIST,.SCERR)
  1.  .;if preceptor notice turned on for message type
  1.  I +$P($G(^SCTM(404.57,SCTP,2)),U,9) D
  1.  .S SCX=+$$OKPREC2^SCMCLK(SCTP,SDDT)
  1.  .;if preceptor duz returned, add to array
  1.  .I SCX S @SCLIST@("SCPR",SCX)=""
  1.  N XMY F I=0:0 S I=$O(@SCLIST@("SCPR",I)) Q:'I  S XMY(I)=""
  1.  S SCTEXT(1,0)="PATIENT "_$P($G(^DPT(DFN,0)),U)_" has been inactivated from PC team position "_$P($G(^SCTM(404.57,SCTP,0)),U)
  1.  S XMSUB="Provider's Inactivated Primary Care Patients" D ^XMD
  1.  Q
  1. BULL ;EOM Bulletin
  1.  N DISUPNO,BY,DHIT,HEAD
  1.  S DISUPNO=1,L=0
  1.  S XMSUB="Patients Scheduled for Inactivation from PC Panel"
  1.  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  1.  K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J),^TMP("SCML",$J)
  1.  S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)=""
  1.  S DIC="^SCPT(404.43,",BY="[SCMC FLAGGED BULLETIN]",FLDS="[SC BULLETIN]",CNT=0
  1.  S:0 FLDS="" S IOP="",DHD="@@",(FR,TO)="" D EN1^DIP
  1.  S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients scheduled for inactivation in next 30 days"
  1.  D LINES(1)
  1.  D ^XMD
  1.  D PRMAIL^SCMCTSK5(1)
  1.  F SCI=0:0 S SCI=$O(^TMP("SCF",$J,SCI)) Q:'SCI  D
  1.  .K XMY S XMY(SCI)="" K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J)
  1.  .M ^TMP("SCMC",$J)=^TMP("SCF",$J,SCI)
  1.  .S XMSUB="Patients Scheduled for Inactivation from PC Panel"
  1.  .S XMTEXT="^TMP(""SCMCTXT"",$J,"
  1.  S DISUPNO=1
  1.  K ^TMP("SCMC",$J),^TMP("SCMCTXT")
  1.  I $G(NOINAC) K ^TMP($J,"SCMCTSK2") Q  ; SD/499
  1.  S XMSUB="Patients With Extended PCMM Inactivation Dates"
  1.  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  1.  K ^TMP("SCMC",$J)
  1.  S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)=""
  1.  S DIC="^SCPT(404.43,",BY="[SCMC EXTENDED BULLETIN]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
  1.  S FR=",,,",TO=FR,FLDS="",IOP="",DHD="@@" D EN1^DIP
  1.  S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Extended from inactivation"
  1.  D LINES(3)
  1.  D ^XMD
  1.  D PRMAIL^SCMCTSK5(3)
  1.  S DISUPNO=1
  1.  K ^TMP("SCMC",$J),^TMP("SCMCTXT")
  1.  S XMSUB="Patients Automated Inactivations from PC Panels"
  1.  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  1.  K ^TMP("SCMC",$J)
  1.  S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)=""
  1.  S DIC="^SCPT(404.43,",BY="[SCMC INACTIVATED]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
  1.  S FLDS="",IOP="",DHD="@@",FR=",T-30,,",TO=",,,,," D EN1^DIP
  1.  S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Inactivated in last 30 days"
  1.  D LINES(2)
  1.  D ^XMD
  1. TST ;
  1.  S DISUPNO=1
  1.  D PRMAIL^SCMCTSK5(2)
  1.  K ^TMP("SCMC",$J),^TMP("SCMCTXT")
  1.  ;I $P($G(^SCTM(404.44,1,1)),U,11)="" D
  1.  S XMSUB="PC Providers Scheduled for Inactivation"
  1.  S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
  1.  K ^TMP("SCMC",$J)
  1.  S XMTEXT="^TMP(""SCMCTXT"",$J,"
  1.  S DIC="^SCTM(404.52,",BY="[SC PROVIDER FLAGGED BULLE]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
  1.  S FLDS="",IOP="",DHD="@@",FR="",TO="" D EN1^DIP
  1.  D LINES(4)
  1.  D ^XMD
  1.  D PRMAIL^SCMCTSK5(4)
  1.  D BULL^SCMCTSK6
  1.  Q
  1. LINES(TYPE) ;Lines of Bulletin
  1.  D LINES^SCMCTSK5(TYPE) Q
  1. ROLE(DATA,INFO) ;SCMC ROLE
  1.  N ROLE,TP,I,SCRSLT,SCTF,SCLS,SCPOR
  1.  S (SCPOR,SCRSLT)=0
  1.  S ROLE=+$G(INFO),TP=+$P($G(INFO),U,2)
  1.  I 'ROLE Q
  1.  I 'TP Q
  1.  ;get values
  1.  S DATA(0)=+$P($G(^SD(403.46,ROLE,0)),U,3)
  1.  I $$DATES^SCAPMCU1(404.53,+TP) S SCPOR=1
  1.  N PREC S PREC=0
  1.  F I=0:0 S I=$O(^SCTM(404.53,"AD",TP,I)) Q:'I  D   Q:PREC
  1.  .I $D(^SCTM(404.53,"AD",TP,I,1)) I '$D(^(0)) S PREC=1
  1.  I +DATA(0)'=0 D
  1.  . S SCTF=$$GETPRTP^SCAPMCU2(TP) Q:+SCTF=0
  1.  . S SCLS=$$GET^XUA4A72(+SCTF)
  1.  . I SCLS S SCRSLT=$S('$D(^SD(403.46,ROLE,2,"B",+SCLS)):1,1:0)
  1.  ;end of get
  1.  ;type of role^preceptor^preceptee^person class check
  1.  S DATA(0)=DATA(0)_U_SCPOR_U_PREC_U_SCRSLT
  1.  Q
  1. INRPT ; REPORT
  1.  N DIOEND,SCDHD
  1.  D PROMPT^SCMCTSK3("** Date Range Selection **","DATE PATIENTS INACTIVATED FROM PC PANELS")
  1.  Q:'$D(^TMP("SC",$J,"XR"))
  1.  D UNASSIGN^SCMCTSK3
  1.  S Q=""""
  1.  S DIC="^SCPT(404.43," ;=0,BY="[SCMC INACTIVATION SORT]"
  1.  D BY
  1.  S (SCDHD,DHD)="AUTOMATED PATIENT INACTIVATION FROM PRIMARY CARE PANELS REPORT"
  1.  S DIOBEG="D DIOBEG^SCMCTSK4"
  1.  S DIOEND="D DIOEND1^SCMCTSK4"
  1.  S FLDS="[SCMC INACTIVATED]" ;,FR="?,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ")
  1.  D EN1^DIP
  1.  Q
  1. IN30 ;inact. last month
  1.  N DIPA,SDD D SORT^SCMCTSK1(.DIPA,.SDD) Q:'SDD  ;SD/499
  1.  S Q=""""
  1.  S DIC="^SCPT(404.43,",L=0,BY="[SCMC INACTIVATION SORT]"
  1.  S DHD="Patients Inactivated from Primary Care Panels in the Past Month"
  1.  S FLDS="[SCMC INACTIVATED]",FR="T-31,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ")
  1.  D EN1^DIP
  1.  Q
  1. EXRPT ;EXTEND REPORT
  1.  K CLIN,TEAM,INST
  1.  D PROMPT^SCMCTSK3("PCMM Patients with Extended Inactivations","Scheduled Inactivation Date")
  1.  Q:'$D(^TMP("SC",$J,"XR"))
  1.  S Q="""",SORT=1
  1.  D EXTEND^SCMCTSK3
  1.  S DIC="^SCPT(404.43," ;,L=0,BY="[SCMC EXTENDED]"
  1.  S (SCDHD,DHD)="PCMM Patients with extended Inactivations"
  1.  S DIOBEG="D DIOBEG^SCMCTSK4",DIOEND="D EXTKEY^SCMCTSK9"
  1.  D BY
  1.  S FLDS="[SCMC EXTENDED]"
  1.  D EN1^DIP
  1.  Q 
  1. BY N DISPAR
  1.  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"
  1.  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
  1.  .I A["PATIENT" I (I>1)!($G(SCDHD)["Patients Scheduled for Inactivation from PC Panel") S $P(DISPAR(0,I),U)="@"
  1.  .I $G(SCDHD)["FTEE" D
  1.  ..I A["PROV" S $P(DISPAR(0,I),U)="@"
  1.  ..I I>1 I (A["CLI")!(A["POS") S $P(DISPAR(0,I),U)="@"_$P($G(DISPAR(0,I)),U)
  1.  S ZTSAVE("^TMP(""SC"",$J,")="",ZTSAVE("^TMP(""SCSORT"",$J,")=""
  1.  Q
  1. FLRPT ;FLAGGED REPORT
  1.  D PROMPT^SCMCTSK3("Patients Scheduled for Inactivation from PC Panels","Date Scheduled for Inactivation")
  1.  Q:'$D(^TMP("SC",$J,"XR"))
  1.  D FLAGG^SCMCTSK3
  1.  S Q=""""
  1.  S DIC="^SCPT(404.43,",L=0
  1.  S (SCDHD,DHD)="Patients Scheduled for Inactivation from PC Panels"
  1.  D BY
  1.  S DIOBEG="D DIOBEG^SCMCTSK4"
  1.  S FLDS="[SCMC PENDING UNASSIGN]"
  1.  I $G(DISPAR(0,1))["PATIENT" S FLDS="[SCMC PENDING UNASSIGN PAT]"
  1.  S DIOEND="D DIOEND^SCMCTSK4"
  1.  D EN1^DIP