Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK2.m
r613 r623 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 ; Compiled March 17, 2008 15:27:15 2 ;;5.3;Scheduling;**297,498,527,499**;AUG 13, 1993;Build 21 3 Q 4 NIGHT ; 5 N ENDDT,NOINAC,SIXM,FLGDT,L,PATDT,SEEN,SDDT 6 D DT^DICRW S SDDT=$P($G(^XTMP("SCMCTSK2-"_DT,0)),U,2) 7 I SDDT="" S SDDT=DT 8 S ALPHA=$G(^SCTM(404.44,1,1)),ALPHA=$P(ALPHA,U,8) I ALPHA<SDDT S ALPHA=0 9 ;if 'ALPHA NOINAC=1 except 15th and the Last Day of a Month (LDoM) 10 ;inact only on 15th and on LDoM 11 S NOINAC=0 12 I 'ALPHA S X1=SDDT,X2=1 D C^%DTC I ($E(SDDT,6,7)'=15)&($E(SDDT,1,5)=$E(X,1,5)) S NOINAC=1 13 I 'ALPHA D INACTIVE^SCMCTSK1 14 S SIXM=$P($G(^SCTM(404.44,1,1)),U,9) 15 I SIXM D PRFLAG 16 I ALPHA D INACTIVE^SCMCTSK1 17 ;determine ENDDT-Inactn Date-30 days if flagged today 18 F DATE=0:0 S DATE=$O(^SCPT(404.43,"AFLG",DATE)) Q:'DATE D 19 .F ENTRY=0:0 S ENTRY=$O(^SCPT(404.43,"AFLG",DATE,ENTRY)) Q:'ENTRY D 20 ..S ZERO=$G(^SCPT(404.43,ENTRY,0)) Q:'ZERO 21 ..S DFN=+$G(^SCPT(404.42,+ZERO,0)) Q:'DFN 22 ..S POS=$P(ZERO,U,2) 23 ..I $P(ZERO,U,4) D UNFLG Q ;unass. 24 ..S X1=DATE,X2=$S(ALPHA:+2,1:+30) D C^%DTC S ENDDT=X 25 ..N SDASS S SDASS=$P(ZERO,U,3) 26 ..;N-new or E-stbl. 27 ..;assig >12 months since flagging, not NEW, E-stbl) 28 ..N NEW 29 ..S NEW=0 S X1=DATE,X2=SDASS D ^%DTC I X<365 S NEW=1 30 ..I NEW S %DT="",X="T-12M" D ^%DT S STDT=+Y D 31 ...S X1=STDT,X2=-7 D C^%DTC S TYDT=X 32 ..I 'NEW S %DT="",X="T-24M" D ^%DT S STDT=+Y D 33 ...S X1=STDT,X2=-7 D C^%DTC S TYDT=X 34 ..; 35 ..I $P(ZERO,U,17) D UNFLG Q ;react. 36 ..;get prec 37 ..;S %DT="",X="T-12M" D ^%DT S STDT=+Y 38 ..;S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS) 39 ..I '$P(ZERO,U,5) D UNFLG Q ;Not PC 40 ..D SEEN^SCMCTSK1(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN) 41 ..;S PC=$$GET^XUA4A72(+PROV) 42 ..I SEEN D UNFLG Q 43 ..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 44 ..I ('NOINAC)&(SDDT'<ENDDT) D DIS^SCMCTSK1 45 ;flag prov 6m after install sd/297 46 I NOINAC D:ALPHA BULL I '$D(^SCPT(404.43,"AFLG",SDDT)) K ^TMP($J,"SCMCTSK2") Q 47 ;flag prov 6m after install sd/297 48 I SIXM,SIXM'>SDDT D 49 .D PRINAC 50 .N FLDA 51 .S FLDA(404.44,"1,",19)="" 52 .D FILE^DIE("I","FLDA","ERR") 53 D BULL K ^TMP($J,"SCMCTSK2") 54 Q 55 UNFLG ;Unflagging 56 N DR,DIE,DA 57 S DR=".15///@;.13///@;.12///@",DIE="^SCPT(404.43,",DA=ENTRY D ^DIE 58 Q 59 PRFLAG ;flag incorrect provider pos 60 N POS 61 ;prov inact. has run once 62 I $P($G(^SCTM(404.44,1,1)),U,11)'="" Q 63 D PRFLAG^SCMCTSK3 64 Q 65 PRINAC ;inact. flagged providers 66 N I,II 67 ;Prov inact. run already 68 I $G(SDDT)="" S SDDT=DT 69 S II=$P($G(^SCTM(404.44,1,1)),U,11) I II'="",II'=SDDT Q 70 F I=0:0 S I=$O(^SCTM(404.52,I)) Q:'I S ZERO=$G(^(I,0)) I $P(ZERO,U,10) D 71 .;I $P(ZERO,U,10)>$G(ENDT) Q ;not time yet 72 .I $O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999))<(-$P(ZERO,U,2)) Q ;inactivated 73 .;Check valid criteria 74 .S POS=+ZERO 75 .S PROV=+$$GETPRTP^SCAPMCU2(POS,SDDT) 76 .S PC=$$GET^XUA4A72(+PROV) 77 .S DR=".091///@",DIE="^SCTM(404.52,",DA=I D ^DIE ;remove flag 78 .S ZERO1=$G(^SCTM(404.57,POS,0)) 79 .I '$D(^SD(403.46,+$P(ZERO1,U,3),2,+PC)) D 80 ..;inactivation 81 ..S DIC="^SCTM(404.52,",X=+ZERO,DIC("DR")=".02////"_SDDT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1" 82 ..S DIC(0)="LM" D ^DIC 83 ;only run inact. once 84 S $P(^SCTM(404.44,1,1),U,11)=SDDT 85 Q 86 FUTAPP(DFN) ;print future appts 87 N TAB,SCDT0 S TAB=$X 88 I $G(SDDT)="" S SDDT=DT 89 S SCDT=SDDT+.24 90 F S SCDT=$O(^DPT(DFN,"S",SCDT)) Q:'SCDT D 91 . S SCDT0=$G(^DPT(DFN,"S",SCDT,0)) Q:$L($P(SCDT0,U,2)) 92 . S CLIEN=$P(SCDT0,"^") Q:'CLIEN 93 . S Y=SCDT X ^DD("DD") W $E(Y_" ",1,17)_" "_$E($P($G(^SC(+CLIEN,0)),U),1,10) 94 Q 95 GETASC(DATA,ENTRY) ;get assoc. clinics 96 N I,CNT S CNT=0 97 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) 98 Q 99 SETASC(RESULT,DATA) ;set assoc. clinics 100 D SETASC^SCMCTSK7(.RESULT,DATA) Q 101 MSG(SCTP,DFN) ;send inact. message 102 ;given valid positions get current practitioners 103 S SCLIST="SCL" 104 I $G(SDDT)="" S SDDT=DT 105 I "N"'[$P($G(^SCTM(404.57,SCTP,2)),U,9) D 106 .S SCOK=$$PRTP^SCAPMC(SCTP,"",.SCLIST,.SCERR) 107 .;if preceptor notice turned on for message type 108 I +$P($G(^SCTM(404.57,SCTP,2)),U,9) D 109 .S SCX=+$$OKPREC2^SCMCLK(SCTP,SDDT) 110 .;if preceptor duz returned, add to array 111 .I SCX S @SCLIST@("SCPR",SCX)="" 112 N XMY F I=0:0 S I=$O(@SCLIST@("SCPR",I)) Q:'I S XMY(I)="" 113 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) 114 S XMSUB="Provider's Inactivated Primary Care Patients" D ^XMD 115 Q 116 BULL ;EOM Bulletin 117 N DISUPNO,BY,DHIT,HEAD 118 S DISUPNO=1,L=0 119 S XMSUB="Patients Scheduled for Inactivation from PC Panel" 120 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 121 K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J),^TMP("SCML",$J) 122 S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)="" 123 S DIC="^SCPT(404.43,",BY="[SCMC FLAGGED BULLETIN]",FLDS="[SC BULLETIN]",CNT=0 124 S:0 FLDS="" S IOP="",DHD="@@",(FR,TO)="" D EN1^DIP 125 S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients scheduled for inactivation in next 30 days" 126 D LINES(1) 127 D ^XMD 128 D PRMAIL^SCMCTSK5(1) 129 F SCI=0:0 S SCI=$O(^TMP("SCF",$J,SCI)) Q:'SCI D 130 .K XMY S XMY(SCI)="" K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J) 131 .M ^TMP("SCMC",$J)=^TMP("SCF",$J,SCI) 132 .S XMSUB="Patients Scheduled for Inactivation from PC Panel" 133 .S XMTEXT="^TMP(""SCMCTXT"",$J," 134 S DISUPNO=1 135 K ^TMP("SCMC",$J),^TMP("SCMCTXT") 136 I $G(NOINAC) K ^TMP($J,"SCMCTSK2") Q ; SD/499 137 S XMSUB="Patients With Extended PCMM Inactivation Dates" 138 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 139 K ^TMP("SCMC",$J) 140 S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)="" 141 S DIC="^SCPT(404.43,",BY="[SCMC EXTENDED BULLETIN]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0 142 S FR=",,,",TO=FR,FLDS="",IOP="",DHD="@@" D EN1^DIP 143 S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Extended from inactivation" 144 D LINES(3) 145 D ^XMD 146 D PRMAIL^SCMCTSK5(3) 147 S DISUPNO=1 148 K ^TMP("SCMC",$J),^TMP("SCMCTXT") 149 S XMSUB="Patients Automated Inactivations from PC Panels" 150 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 151 K ^TMP("SCMC",$J) 152 S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)="" 153 S DIC="^SCPT(404.43,",BY="[SCMC INACTIVATED]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0 154 S FLDS="",IOP="",DHD="@@",FR=",T-30,,",TO=",,,,," D EN1^DIP 155 S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Inactivated in last 30 days" 156 D LINES(2) 157 D ^XMD 158 S DISUPNO=1 159 D PRMAIL^SCMCTSK5(2) 160 K ^TMP("SCMC",$J),^TMP("SCMCTXT") 161 I $P($G(^SCTM(404.44,1,1)),U,11)="" D 162 . S XMSUB="PC Providers Scheduled for Inactivation" 163 . S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 164 . K ^TMP("SCMC",$J) 165 . S XMTEXT="^TMP(""SCMCTXT"",$J," 166 . S DIC="^SCTM(404.52,",BY="[SC PROVIDER FLAGGED BULLE]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0 167 . S FLDS="",IOP="",DHD="@@",FR="",TO="" D EN1^DIP 168 . D LINES(4) 169 . D ^XMD 170 . D PRMAIL^SCMCTSK5(4) 171 . D BULL^SCMCTSK6 172 Q 173 LINES(TYPE) ;Lines of Bulletin 174 D LINES^SCMCTSK5(TYPE) Q 175 ROLE(DATA,INFO) ;SCMC ROLE 176 N ROLE,TP,I 177 S ROLE=+$G(INFO),TP=+$P($G(INFO),U,2) 178 S DATA(0)="0^0^0" 179 I 'ROLE Q 180 I 'TP Q 181 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 182 I $$DATES^SCAPMCU1(404.53,+TP) S DATA(0)=DATA(0)_"^1^0" Q 183 N PREC S PREC=0 184 F I=0:0 S I=$O(^SCTM(404.53,"AD",TP,I)) Q:'I D Q:PREC 185 .I $D(^SCTM(404.53,"AD",TP,I,1)) I '$D(^(0)) S PREC=1 186 I PREC S DATA(0)=DATA(0)_"^0^1" Q 187 S DATA(0)=DATA(0)_"^0^0" 188 Q 189 INRPT ; REPORT 190 N DIOEND,SCDHD 191 D PROMPT^SCMCTSK3("** Date Range Selection **","DATE PATIENTS INACTIVATED FROM PC PANELS") 192 Q:'$D(^TMP("SC",$J,"XR")) 193 D UNASSIGN^SCMCTSK3 194 S Q="""" 195 S DIC="^SCPT(404.43," ;=0,BY="[SCMC INACTIVATION SORT]" 196 D BY 197 S (SCDHD,DHD)="AUTOMATED PATIENT INACTIVATION FROM PRIMARY CARE PANELS REPORT" 198 S DIOBEG="D DIOBEG^SCMCTSK4" 199 S DIOEND="D DIOEND1^SCMCTSK4" 200 S FLDS="[SCMC INACTIVATED]" ;,FR="?,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ") 201 D EN1^DIP 202 Q 203 IN30 ;inact. last month 204 N DIPA,SDD D SORT^SCMCTSK1(.DIPA,.SDD) Q:'SDD ;SD/499 205 S Q="""" 206 S DIC="^SCPT(404.43,",L=0,BY="[SCMC INACTIVATION SORT]" 207 S DHD="Patients Inactivated from Primary Care Panels in the Past Month" 208 S FLDS="[SCMC INACTIVATED]",FR="T-31,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ") 209 D EN1^DIP 210 Q 211 EXRPT ;EXTEND REPORT 212 K CLIN,TEAM,INST 213 D PROMPT^SCMCTSK3("PCMM Patients with Extended Inactivations","Scheduled Inactivation Date") 214 Q:'$D(^TMP("SC",$J,"XR")) 215 S Q="""",SORT=1 216 D EXTEND^SCMCTSK3 217 S DIC="^SCPT(404.43," ;,L=0,BY="[SCMC EXTENDED]" 218 S (SCDHD,DHD)="PCMM Patients with extended Inactivations" 219 S DIOBEG="D DIOBEG^SCMCTSK4",DIOEND="D EXTKEY^SCMCTSK9" 220 D BY 221 S FLDS="[SCMC EXTENDED]" 222 D EN1^DIP 223 Q 224 BY N DISPAR 225 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" 226 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 227 .I A["PATIENT" I (I>1)!($G(SCDHD)["Patients Scheduled for Inactivation from PC Panel") S $P(DISPAR(0,I),U)="@" 228 .I $G(SCDHD)["FTEE" D 229 ..I A["PROV" S $P(DISPAR(0,I),U)="@" 230 ..I I>1 I (A["CLI")!(A["POS") S $P(DISPAR(0,I),U)="@"_$P($G(DISPAR(0,I)),U) 231 S ZTSAVE("^TMP(""SC"",$J,")="",ZTSAVE("^TMP(""SCSORT"",$J,")="" 232 Q 233 FLRPT ;FLAGGED REPORT 234 D PROMPT^SCMCTSK3("Patients Scheduled for Inactivation from PC Panels","Date Scheduled for Inactivation") 235 Q:'$D(^TMP("SC",$J,"XR")) 236 D FLAGG^SCMCTSK3 237 S Q="""" 238 S DIC="^SCPT(404.43,",L=0 239 S (SCDHD,DHD)="Patients Scheduled for Inactivation from PC Panels" 240 D BY 241 S DIOBEG="D DIOBEG^SCMCTSK4" 242 S FLDS="[SCMC PENDING UNASSIGN]" 243 I $G(DISPAR(0,1))["PATIENT" S FLDS="[SCMC PENDING UNASSIGN PAT]" 244 S DIOEND="D DIOEND^SCMCTSK4" 245 D EN1^DIP 1 SCMCTSK2 ;ALB/JDS - PCMM Inactivation Nightly Job; 18 Apr 2003 9:36 AM ; 10/24/07 12:23pm 2 ;;5.3;Scheduling;**297,498,527**;AUG 13, 1993;Build 6 3 Q 4 NIGHT ;nightly task for inact. 5 N ENDDT,NOINAC,SIXM,FLGDT,L,PATDT,SEEN 6 K ^TMP("SCTSK",$J) 7 D DT^DICRW 8 S ALPHA=$G(^SCTM(404.44,1,1)),ALPHA=$P(ALPHA,U,8) I ALPHA<DT S ALPHA=0 9 ;check if this is last day of month 10 S X1=DT,X2=1 D C^%DTC I $E(DT,1,5)'=$E(X,1,5) I 'ALPHA D INACTIVE^SCMCTSK1 11 S SIXM=$P($G(^SCTM(404.44,1,1)),U,9) 12 I SIXM D PRFLAG 13 I ALPHA D INACTIVE^SCMCTSK1 14 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 15 ;check for 60 days after flagged for inact. 16 S X1=DT,X2=$S(ALPHA:-2,1:-30) D C^%DTC S ENDDT=X 17 F DATE=0:0 S DATE=$O(^SCPT(404.43,"AFLG",DATE)) Q:(('DATE)!(('NOINAC)&(DATE>ENDDT))) D 18 .F ENTRY=0:0 S ENTRY=$O(^SCPT(404.43,"AFLG",DATE,ENTRY)) Q:'ENTRY D 19 ..S ZERO=$G(^SCPT(404.43,ENTRY,0)) Q:'ZERO 20 ..S DFN=+$G(^SCPT(404.42,+ZERO,0)) Q:'DFN 21 ..S POS=$P(ZERO,U,2) 22 ..I $P(ZERO,U,4) D UNFLG Q ;already unassigned 23 ..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 24 ..;check if criteria still met 25 ..I $P(ZERO,U,17) D UNFLG Q ;Already reactivated 26 ..;get preceptor position 27 ..S %DT="",X="T-12M" D ^%DT S STDT=+Y 28 ..S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS) 29 ..;see if provider changed 30 ..I $O(^SCTM(404.52,"AIDT",+PREC,1,-STDT),-1) D UNFLG Q 31 ..I '$P(ZERO,U,5) D UNFLG Q ;Not primary care 32 ..S PROV=+$$GETPRTP^SCAPMCU2(POS,DT) 33 ..S PC=$$GET^XUA4A72(+PROV) 34 ..S SC297=$$PDAT^SCMCGU("SD*5.3*297") 35 ..N NEW S NEW=$S($P(ZERO,U,3)<SC297:0,1:1) ;D D^%DTC S NEW=$S(X>330:0,1:1) 36 ..S X1=DT,X2=SC297 D D^%DTC S SC297=X 37 ..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 38 ..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 39 ..I ('NOINAC)&(DATE'>ENDDT) D DIS^SCMCTSK1 40 ..;D MSG(POS,DFN) 41 ;if 6 months after installation check to flag providers 42 I NOINAC D:ALPHA BULL Q 43 S PATDT=$$PDAT^SCMCGU("SD*5.3*297") Q:'PATDT 44 I SIXM,SIXM'>DT D 45 .D PRINAC 46 .N FLDA 47 .S FLDA(404.44,"1,",19)="" 48 .D FILE^DIE("I","FLDA","ERR") 49 D BULL 50 Q 51 UNFLG ;Remove the flag 52 N DR,DIE,DA 53 S DR=".15///@;.13///@;.12///@",DIE="^SCPT(404.43,",DA=ENTRY D ^DIE 54 Q 55 PRFLAG ;flag incorrect provider positions 56 N POS 57 ;provider inactivation has run once 58 I $P($G(^SCTM(404.44,1,1)),U,11)'="" Q 59 D PRFLAG^SCMCTSK3 60 Q 61 PRINAC ;inactivate flagged providers 62 N I,II 63 ;Provider inactivation run already 64 S II=$P($G(^SCTM(404.44,1,1)),U,11) I II'="",II'=DT Q 65 F I=0:0 S I=$O(^SCTM(404.52,I)) Q:'I S ZERO=$G(^(I,0)) I $P(ZERO,U,10) D 66 .;I $P(ZERO,U,10)>$G(ENDT) Q ;not time yet 67 .I $O(^SCTM(404.52,"AIDT",+ZERO,0,-9999999))<(-$P(ZERO,U,2)) Q ;already inactivated 68 .;Check if criteria still valid 69 .S POS=+ZERO 70 .S PROV=+$$GETPRTP^SCAPMCU2(POS,DT) 71 .S PC=$$GET^XUA4A72(+PROV) 72 .S DR=".091///@",DIE="^SCTM(404.52,",DA=I D ^DIE ;remove flag 73 .S ZERO1=$G(^SCTM(404.57,POS,0)) 74 .I '$D(^SD(403.46,+$P(ZERO1,U,3),2,+PC)) D 75 ..;enter the inactivation 76 ..S DIC="^SCTM(404.52,",X=+ZERO,DIC("DR")=".02////"_DT_";.03////"_$P(ZERO,U,3)_";.04////0;.05///EMPLOYEE LEAVES POSITION;.11////1" 77 ..S DIC(0)="LM" D ^DIC 78 ;only run the inactivation once. 79 S $P(^SCTM(404.44,1,1),U,11)=DT 80 Q 81 FUTAPP(DFN) ;print future appointments 82 N TAB,SCDT0 S TAB=$X 83 S SCDT=DT+.24 84 F S SCDT=$O(^DPT(DFN,"S",SCDT)) Q:'SCDT D 85 . S SCDT0=$G(^DPT(DFN,"S",SCDT,0)) Q:$L($P(SCDT0,U,2)) 86 . S CLIEN=$P(SCDT0,"^") Q:'CLIEN 87 . S Y=SCDT X ^DD("DD") W $E(Y_" ",1,17)_" "_$E($P($G(^SC(+CLIEN,0)),U),1,10) 88 Q 89 GETASC(DATA,ENTRY) ;get associated clinics 90 N I,CNT S CNT=0 91 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) 92 Q 93 SETASC(RESULT,DATA) ;set associated clinics 94 D SETASC^SCMCTSK7(.RESULT,DATA) Q 95 MSG(SCTP,DFN) ;send inactivation message 96 ;given list of valid positions get current practitioners 97 S SCLIST="SCL" 98 I "N"'[$P($G(^SCTM(404.57,SCTP,2)),U,9) D 99 .S SCOK=$$PRTP^SCAPMC(SCTP,"",.SCLIST,.SCERR) 100 .;if preceptor notice turned on for message type 101 I +$P($G(^SCTM(404.57,SCTP,2)),U,9) D 102 .S SCX=+$$OKPREC2^SCMCLK(SCTP,DT) 103 .;if preceptor duz returned, add to array 104 .I SCX S @SCLIST@("SCPR",SCX)="" 105 N XMY F I=0:0 S I=$O(@SCLIST@("SCPR",I)) Q:'I S XMY(I)="" 106 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) 107 S XMSUB="Provider's Inactivated Primary Care Patients" D ^XMD 108 Q 109 BULL ;end of Month Bulletin 110 N DISUPNO,BY,DHIT,HEAD 111 S DISUPNO=1,L=0 112 S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel" 113 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 114 K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J),^TMP("SCML",$J) 115 S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)="" 116 S DIC="^SCPT(404.43,",BY="[SCMC FLAGGED BULLETIN]",FLDS="[SC BULLETIN]",CNT=0 117 S:0 FLDS="" S IOP="",DHD="@@",(FR,TO)="" D EN1^DIP 118 S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients scheduled for inactivation in next 30 days" 119 D LINES(1) 120 D ^XMD 121 D PRMAIL^SCMCTSK5(1) 122 F SCI=0:0 S SCI=$O(^TMP("SCF",$J,SCI)) Q:'SCI D 123 .K XMY S XMY(SCI)="" K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J) 124 .M ^TMP("SCMC",$J)=^TMP("SCF",$J,SCI) 125 .S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel" 126 .S XMTEXT="^TMP(""SCMCTXT"",$J," 127 .;D LINES(1) D ^XMD 128 S DISUPNO=1 129 K ^TMP("SCMC",$J),^TMP("SCMCTXT") 130 S XMSUB="Patients With Extended PCMM Inactivation Dates" 131 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 132 K ^TMP("SCMC",$J) 133 S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)="" 134 S DIC="^SCPT(404.43,",BY="[SCMC EXTENDED BULLETIN]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0 135 S FR=",,,",TO=FR,FLDS="",IOP="",DHD="@@" D EN1^DIP 136 S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Extended from inactivation" 137 D LINES(3) 138 D ^XMD 139 D PRMAIL^SCMCTSK5(3) 140 S DISUPNO=1 141 K ^TMP("SCMC",$J),^TMP("SCMCTXT") 142 S XMSUB="Patients Automated Inactivations from Primary Care Panels" 143 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 144 K ^TMP("SCMC",$J) 145 S XMTEXT="^TMP(""SCMCTXT"",$J," ;S @XMTEXT@(0)="" 146 S DIC="^SCPT(404.43,",BY="[SCMC INACTIVATED]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0 147 S FLDS="",IOP="",DHD="@@",FR=",T-30,,",TO=",,,,," D EN1^DIP 148 S ^TMP("SCMCTXT",$J,1,0)="There are "_$O(^TMP("SCMC",$J,""),-1)_" Patients Inactivated in last 30 days" 149 D LINES(2) 150 D ^XMD 151 S DISUPNO=1 152 D PRMAIL^SCMCTSK5(2) 153 K ^TMP("SCMC",$J),^TMP("SCMCTXT") 154 I $P($G(^SCTM(404.44,1,1)),U,11)="" D 155 . S XMSUB="Primary Care Providers Scheduled for Inactivation" 156 . S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")="" 157 . K ^TMP("SCMC",$J) 158 . S XMTEXT="^TMP(""SCMCTXT"",$J," 159 . S DIC="^SCTM(404.52,",BY="[SC PROVIDER FLAGGED BULLE]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0 160 . S FLDS="",IOP="",DHD="@@",FR="",TO="" D EN1^DIP 161 . D LINES(4) 162 . D ^XMD 163 . D PRMAIL^SCMCTSK5(4) 164 . D BULL^SCMCTSK6 165 Q 166 LINES(TYPE) ;Lines of Bulletin 167 D LINES^SCMCTSK5(TYPE) Q 168 ROLE(DATA,INFO) ;SCMC ROLE 169 N ROLE,TP,I 170 S ROLE=+$G(INFO),TP=+$P($G(INFO),U,2) 171 S DATA(0)="0^0^0" 172 I 'ROLE Q 173 I 'TP Q 174 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 175 I $$DATES^SCAPMCU1(404.53,+TP) S DATA(0)=DATA(0)_"^1^0" Q 176 N PREC S PREC=0 177 F I=0:0 S I=$O(^SCTM(404.53,"AD",TP,I)) Q:'I D Q:PREC 178 .I $D(^SCTM(404.53,"AD",TP,I,1)) I '$D(^(0)) S PREC=1 179 I PREC S DATA(0)=DATA(0)_"^0^1" Q 180 S DATA(0)=DATA(0)_"^0^0" 181 Q 182 INRPT ; REPORT 183 N DIOEND,SCDHD 184 D PROMPT^SCMCTSK3("**** Date Range Selection ****","DATE PATIENTS INACTIVATED FROM PRIMARY CARE PANELS") 185 Q:'$D(^TMP("SC",$J,"XR")) 186 D UNASSIGN^SCMCTSK3 187 S Q="""" 188 S DIC="^SCPT(404.43," ;=0,BY="[SCMC INACTIVATION SORT]" 189 D BY 190 S (SCDHD,DHD)="AUTOMATED PATIENT INACTIVATION FROM PRIMARY CARE PANELS REPORT" 191 S DIOBEG="D DIOBEG^SCMCTSK4" 192 S DIOEND="D DIOEND1^SCMCTSK4" 193 S FLDS="[SCMC INACTIVATED]" ;,FR="?,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ") 194 D EN1^DIP 195 Q 196 IN30 ;inactivated last month 197 D SORT^SCMCTSK1 Q:'X 198 S Q="""" 199 S DIC="^SCPT(404.43,",L=0,BY="[SCMC INACTIVATION SORT]" 200 S DHD="Patients Inactivated from Primary Care Panels in the Past Month" 201 S FLDS="[SCMC INACTIVATED]",FR="T-31,,"_$TR(DIPA("SI"),","," "),TO="T,,"_$TR(DIPA("EI")_"z",","," ") 202 D EN1^DIP 203 Q 204 EXRPT ;EXTEND REPORT 205 K CLIN,TEAM,INST 206 D PROMPT^SCMCTSK3("PCMM Patients with Extended Inactivations","Scheduled Inactivation Date") 207 Q:'$D(^TMP("SC",$J,"XR")) 208 S Q="""",SORT=1 209 D EXTEND^SCMCTSK3 210 S DIC="^SCPT(404.43," ;,L=0,BY="[SCMC EXTENDED]" 211 S (SCDHD,DHD)="PCMM Patients with extended Inactivations" 212 S DIOBEG="D DIOBEG^SCMCTSK4",DIOEND="D EXTKEY^SCMCTSK9" 213 D BY 214 S FLDS="[SCMC EXTENDED]" 215 D EN1^DIP 216 Q 217 BY N DISPAR 218 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" 219 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 220 .I A["PATIENT" I (I>1)!($G(SCDHD)["Patients Scheduled for Inactivation from PC Panel") S $P(DISPAR(0,I),U)="@" 221 .I $G(SCDHD)["FTEE" D 222 ..I A["PROV" S $P(DISPAR(0,I),U)="@" 223 ..I I>1 I (A["CLI")!(A["POS") S $P(DISPAR(0,I),U)="@"_$P($G(DISPAR(0,I)),U) 224 S ZTSAVE("^TMP(""SC"",$J,")="",ZTSAVE("^TMP(""SCSORT"",$J,")="" 225 Q 226 FLRPT ;FLAGGED REPORT 227 D PROMPT^SCMCTSK3("Patients Scheduled for Inactivation from PC Panels","Date Scheduled for Inactivation") 228 Q:'$D(^TMP("SC",$J,"XR")) 229 D FLAGG^SCMCTSK3 230 S Q="""" 231 S DIC="^SCPT(404.43,",L=0 232 S (SCDHD,DHD)="Patients Scheduled for Inactivation from PC Panels" 233 D BY 234 S DIOBEG="D DIOBEG^SCMCTSK4" 235 S FLDS="[SCMC PENDING UNASSIGN]" 236 I $G(DISPAR(0,1))["PATIENT" S FLDS="[SCMC PENDING UNASSIGN PAT]" 237 S DIOEND="D DIOEND^SCMCTSK4" 238 D EN1^DIP
Note:
See TracChangeset
for help on using the changeset viewer.
