[628] | 1 | SCMCTSK1 ;ALB/JDS - PCMM Inactivations; 18 Apr 2003 9:36 AM ; 10/24/07 12:24pm ; Compiled January 25, 2008 12:11:43 ; Compiled March 26, 2008 22:27:26
|
---|
| 2 | ;;5.3;Scheduling;**297,498,527,499**;AUG 13, 1993;Build 21
|
---|
| 3 | Q
|
---|
| 4 | INACTIVE ;
|
---|
| 5 | ;Flag patients
|
---|
| 6 | N I,CNT,SC297,TPZ,TYDT,TEAMN,STDT,Q,SDDT,STDD S CNT=0
|
---|
| 7 | D DT^DICRW
|
---|
| 8 | N SD1 S SDDT="" F SD1=DT,DT-1 I $D(^XTMP("SCMCTSK2-"_SD1,$J,"START")) S SDDT=SD1 Q
|
---|
| 9 | I SDDT'>0 D DT^DICRW S SDDT=DT
|
---|
| 10 | S %DT="",X="T-11M" D ^%DT S STDD=+Y
|
---|
| 11 | S A="^SCPT(404.43,""ADFN""",L=""""""
|
---|
| 12 | S Q=A_")"
|
---|
| 13 | F S Q=$Q(@Q) Q:Q'[A D
|
---|
| 14 | .S ENTRY=+$P(Q,",",6)
|
---|
| 15 | .S ZERO=$G(^SCPT(404.43,+ENTRY,0))
|
---|
| 16 | .I $P(ZERO,U,15) Q
|
---|
| 17 | .S POS=+$P(ZERO,U,2)
|
---|
| 18 | .I $P(ZERO,U,4) Q ;UNASS
|
---|
| 19 | .I '$P(ZERO,U,5) Q ;Not PC
|
---|
| 20 | .I $P(ZERO,U,3)>STDD Q ;<11 months
|
---|
| 21 | .I $P(ZERO,U,17) Q ;React
|
---|
| 22 | .;get preceptor
|
---|
| 23 | .S PREC=$$DATES^SCAPMCU1(404.53,+POS),PREC=$S(PREC:$P($G(^SCTM(404.53,+$P(PREC,U,4),0)),U,6),1:+POS)
|
---|
| 24 | .S DFN=$P(Q,",",3)
|
---|
| 25 | .I $G(XPDIDTOT),('(DFN#5)) D UPDATE^XPDID(DFN)
|
---|
| 26 | .S TEAM=$P(Q,",",4),TEAMNM=$P($G(^SCTM(404.51,+TEAM,0)),U)
|
---|
| 27 | .N STDT S %DT="",X="T-12M" D ^%DT S STDT=+Y
|
---|
| 28 | .;N-new or E-est
|
---|
| 29 | .N NEW
|
---|
| 30 | .I $P(ZERO,U,3)<STDT S NEW=0
|
---|
| 31 | .E S NEW=1
|
---|
| 32 | .N TYDT
|
---|
| 33 | .I NEW N STDT S %DT="",X="T-11M" D ^%DT S STDT=+Y D
|
---|
| 34 | ..S X1=STDT,X2=-7 D C^%DTC S TYDT=X
|
---|
| 35 | .I 'NEW N STDT S %DT="",X="T-23M" D ^%DT S STDT=+Y Q:$P(ZERO,U,3)'<STDT D
|
---|
| 36 | ..S X1=STDT,X2=-7 D C^%DTC S TYDT=X
|
---|
| 37 | .N PROV,SEEN,PRECP D SEEN(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN) Q:SEEN
|
---|
| 38 | .;flag
|
---|
| 39 | .S DIE="^SCPT(404.43,",DR=".15////"_SDDT,DA=ENTRY D ^DIE
|
---|
| 40 | .S TPZ=$G(^SCTM(404.57,+POS,2))
|
---|
| 41 | .I "TP"[$P(TPZ,U,9) I $G(PROV) S CNT=CNT+1,^TMP("SCF",$J,PROV,CNT,ENTRY)=""
|
---|
| 42 | .I $P(TPZ,U,10),$G(PRECP) S CNT=CNT+1,^TMP("SCF",$J,PRECP,CNT,ENTRY)=""
|
---|
| 43 | Q
|
---|
| 44 | SEEN(DFN,POS,TYDT,SDDT,PROV,PROVP,SEEN) ;
|
---|
| 45 | S SEEN=0,PROVP=""
|
---|
| 46 | N SCPRO,I,PRO,X,SCPRDTS,SCPR,PREC
|
---|
| 47 | S PROV=+$$GETPRTP^SCAPMCU2(POS,SDDT)
|
---|
| 48 | S SCPRDTS("BEGIN")=TYDT,SCPRDTS("END")=SDDT,SCPRDTS("INCL")=0
|
---|
| 49 | S X=$$PRTP^SCAPMC(POS,"SCPRDTS","SCPR")
|
---|
| 50 | S I=0 F S I=$O(SCPR(I)) Q:'I S SCPRO(+SCPR(I))="",SCPRO(+SCPR(I),I)=$P(SCPR(I),U,9,10) D
|
---|
| 51 | .S PREC=$P(SCPR(I),U,12)
|
---|
| 52 | .I PREC,PREC'=POS S PROVP=+$$GETPRTP^SCAPMCU2(PREC,SDDT) S SCPRO(+PROVP)="" S SCPRO(+PROVP,I)=$P(SCPR(I),U,9,10)
|
---|
| 53 | F I=TYDT:0 S I=$O(^SCE("ADFN",DFN,I)) Q:'I D Q:SEEN
|
---|
| 54 | .S J=0 F S J=$O(^SCE("ADFN",DFN,I,J)) Q:'J D Q:SEEN
|
---|
| 55 | ..N VISIT S VISIT=+$P($G(^SCE(J,0)),U,5) I $G(^SCE(J,0))<$G(TYDT) Q
|
---|
| 56 | ..S PRO=0 F S PRO=$O(SCPRO(PRO)) Q:'PRO D Q:SEEN
|
---|
| 57 | ...I $D(^SDD(409.44,"AO",J,$G(PRO))) D CHK I SEEN=1 Q
|
---|
| 58 | ...N V F V=0:0 S V=$O(^AUPNVPRV("AD",VISIT,V)) Q:'V I PRO=(+$G(^AUPNVPRV(V,0))) D CHK I SEEN=1 Q
|
---|
| 59 | Q
|
---|
| 60 | CHK ;
|
---|
| 61 | N SDX S SDX="" F S SDX=$O(SCPRO(PRO,SDX)) Q:SDX="" D Q:SEEN
|
---|
| 62 | .I $P(SCPRO(PRO,SDX),U,2)="" D Q
|
---|
| 63 | ..I I'<$P(SCPRO(PRO,SDX),U) S SEEN=1
|
---|
| 64 | .I I'<TYDT&(I'>$P(SCPRO(PRO,SDX),U,2)) S SEEN=1
|
---|
| 65 | Q
|
---|
| 66 | DIS ;disch
|
---|
| 67 | N ZERO S ZERO=$G(^SCPT(404.43,+ENTRY,0))
|
---|
| 68 | I $P(ZERO,U,4) Q
|
---|
| 69 | D DIS2^SCMCTSK7
|
---|
| 70 | Q
|
---|
| 71 | CHKENR(DATA,INFO) ;check if patient enrolled in teamposition clinic
|
---|
| 72 | S DATA(0)=-1
|
---|
| 73 | Q
|
---|
| 74 | EXTEND(DATA,SCTEAM) ;to inact. in next 60 days
|
---|
| 75 | ;IEN^POSITION^PATIENT^EXTENDED^REASON
|
---|
| 76 | K DATA,SCDATA,SDDATA
|
---|
| 77 | N CNT,I,J,K,A,POSA S CNT=1 S SCTEAM=$G(SCTEAM),DATA(1)="<DATA>"
|
---|
| 78 | D DT^DICRW
|
---|
| 79 | N SD1 S SDDT="" F SD1=DT,DT-1 I $D(^XTMP("SCMCTSK2-"_SD1,$J,"START")) S SDDT=SD1 Q
|
---|
| 80 | I SDDT'>0 D DT^DICRW S SDDT=DT
|
---|
| 81 | S X="T-9M" D ^%DT S STDT=Y
|
---|
| 82 | S X="T-21M" D ^%DT S TYDT=+Y ;MAKE THIS 21
|
---|
| 83 | S POSA=""
|
---|
| 84 | S POS=+$P(SCTEAM,U,2) I POS D POS,EX1 Q
|
---|
| 85 | F S POSA=$O(^SCTM(404.57,"ATMPOS",+SCTEAM,POSA)) Q:POSA="" D Q:CNT>100
|
---|
| 86 | .F POS=0:0 S POS=$O(^SCTM(404.57,"ATMPOS",+SCTEAM,POSA,POS)) Q:'POS D POS Q:CNT>100
|
---|
| 87 | I CNT>100 S DATA(1)="TOO MANY" Q
|
---|
| 88 | EX1 S A="SDDATA",CNT=1 F S A=$Q(@A) Q:A="" D
|
---|
| 89 | .S B=@A
|
---|
| 90 | .S DATA(CNT)=(+$P(B,U,3))_U_$TR($P($P(A,"(",2),","),$C(34))_U_$TR($P(B,U,2),$C(34))_U_$P($G(^SCPT(404.43,+$P(B,U,3),0)),U,13)_U_$P($G(^SCPT(404.43,+$P(B,U,3),0)),U,14)
|
---|
| 91 | .S CNT=CNT+1
|
---|
| 92 | Q
|
---|
| 93 | POS I '$$DATES^SCAPMCU1(404.59,POS) Q ;Position inact
|
---|
| 94 | I '$P($G(^SCTM(404.57,POS,0)),U,4) Q ;Not PC
|
---|
| 95 | ;patients for position
|
---|
| 96 | K ^TMP("SC TMP LIST",$J)
|
---|
| 97 | S X=$$PTTP^SCAPMC(POS,"",.SCLIST,.SCERR)
|
---|
| 98 | S J=0 F S J=$O(@SCLIST@(J)) Q:'J S SCDATA=^(J) D
|
---|
| 99 | .N J I $P(SCDATA,U,4)>STDT Q
|
---|
| 100 | .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,5) Q
|
---|
| 101 | .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,15) Q
|
---|
| 102 | .S DFN=+SCDATA
|
---|
| 103 | .D SEEN(DFN,POS,TYDT,SDDT,.PROV,.PRECP,.SEEN) Q:SEEN
|
---|
| 104 | .S SDDATA($P($G(^SCTM(404.57,POS,0)),U),$P(SCDATA,U,2),+SCDATA)=SCDATA,CNT=CNT+1
|
---|
| 105 | K @SCLIST
|
---|
| 106 | Q
|
---|
| 107 | FILE(RES,DATA) ;File data on FTEE
|
---|
| 108 | N I
|
---|
| 109 | F I=1:1 Q:'$D(DATA(I)) D
|
---|
| 110 | .S $P(DATA(I),U,7)=$TR($P(DATA(I),U,7),"[]")
|
---|
| 111 | .S ZERO=$G(^SCPT(404.43,+DATA(I),0))
|
---|
| 112 | .I $P(ZERO,U,13)=$P(DATA(I),U,6) I $P(ZERO,U,14)=$P(DATA(I),U,7) Q
|
---|
| 113 | .S FLDA(404.43,(+DATA(I))_",",.13)=$P(DATA(I),U,6)
|
---|
| 114 | .S FLDA(404.43,(+DATA(I))_",",.14)=$E($P(DATA(I),U,7),1,50)
|
---|
| 115 | .S FLDA(404.43,(+DATA(I))_",",.16)="`"_(+$G(DUZ))
|
---|
| 116 | I $O(FLDA(0)) D FILE^DIE("E","FLDA","ERR")
|
---|
| 117 | Q
|
---|
| 118 | SCREEN ;Active assign. screen
|
---|
| 119 | N A S A=$G(^SCTM(404.52,D0,0))
|
---|
| 120 | N J S J=-(DT+1),J=$O(^SCTM(404.52,"AIDT",+A,1,J)) I J="" S X=0 Q
|
---|
| 121 | I '$P($G(^SCTM(404.57,+A,0)),U,4) Q ;Not PC
|
---|
| 122 | I '$$DATES^SCAPMCU1(404.59,+A) Q ;Not an active position
|
---|
| 123 | I $O(^SCTM(404.52,"AIDT",+A,0,-(DT+1)))<J S X=0 Q
|
---|
| 124 | I '$D(^SCTM(404.52,"AIDT",+A,1,J,D0)) S X=0 Q
|
---|
| 125 | S X=1 Q
|
---|
| 126 | SUM(PR,POSI) ;get pos for prov
|
---|
| 127 | N I,INS,ZERO,SCA,TEAM,FTEE,Z
|
---|
| 128 | S I="",FTEE=0
|
---|
| 129 | F S I=$O(^SCTM(404.52,"C",PR,I),-1) Q:'I D
|
---|
| 130 | .S ZERO=$G(^SCTM(404.52,I,0)) Q:$D(SCA(+ZERO)) Q:(POSI=(+ZERO)) S SCA(+ZERO)=""
|
---|
| 131 | .S INS=$P($G(^SCTM(404.51,+$P($G(^SCTM(404.57,+ZERO,0)),U,2),0)),U,7)
|
---|
| 132 | .S ACTIVE=$$DATES^SCAPMCU1(404.52,+ZERO,DT+.5) Q:'ACTIVE
|
---|
| 133 | .S (Z,ZERO)=$G(^SCTM(404.52,+$P(ACTIVE,U,4),0)) Q:$P(Z,U,3)'=PR
|
---|
| 134 | .S ACTIVE=$$DATES^SCAPMCU1(404.59,+Z,DT+.5) Q:'ACTIVE
|
---|
| 135 | .S Z=$G(^SCTM(404.57,+Z,0))
|
---|
| 136 | .Q:'$P(Z,U,4) ;Cannot be primary
|
---|
| 137 | .S TEAM=$G(^SCTM(404.51,+$P(Z,U,2),0))
|
---|
| 138 | .Q:'$P(TEAM,U,5)
|
---|
| 139 | .S FTEE=FTEE+$P(ZERO,U,9)
|
---|
| 140 | Q FTEE
|
---|
| 141 | FTEECHK(DATA,PAIEN) ;check Ftee>1
|
---|
| 142 | N A S A=$G(^SCTM(404.52,+PAIEN,0)),FTEE=$$SUM(+$P(PAIEN,U,3),+A)
|
---|
| 143 | S DATA=0
|
---|
| 144 | S DATA=FTEE+$P(PAIEN,U,2)
|
---|
| 145 | Q
|
---|
| 146 | SORT(DIPA,SDD) ;sort tmpl
|
---|
| 147 | N DIC
|
---|
| 148 | S DIC=4,DIC(0)="ZME"
|
---|
| 149 | S DIC("S")="I $D(^SCTM(404.51,""AINST"",+Y))"
|
---|
| 150 | S DIR("A")="Start with Institution",DIR("B")="FIRST",DIR(0)="F" D ^DIR
|
---|
| 151 | I X="FIRST" S DIPA("SI")="",DIPA("EI")="zzz",SDD=1 Q
|
---|
| 152 | D ^DIC I Y<0 S DIPA("SI")=X S SDD=X Q:SDD[U D
|
---|
| 153 | .S DIR("A")="Go to Institutiton",DIR("B")="LAST" S DIR(0)="F" D ^DIR
|
---|
| 154 | .I X="LAST" S DIPA("EI")="zzz"
|
---|
| 155 | I Y>0 S DIPA("SI")=$P(Y(0),U),DIC(0)="AZQME",DIC("A")="Go to Institution: "
|
---|
| 156 | D ^DIC
|
---|
| 157 | I Y>0 S DIPA("EI")=$P(Y(0),U)
|
---|
| 158 | I Y<0 S DIPA("EI")=X S SDD=X Q:SDD[U
|
---|
| 159 | S SDD=1 Q
|
---|
| 160 | FTEERPT ;FTEE REPORT
|
---|
| 161 | D FTERPT^SCMCTSK6 Q
|
---|
| 162 | Q
|
---|
| 163 | POSCHK(DATA,INFO) ;
|
---|
| 164 | N PCLASS
|
---|
| 165 | ;TEAM POSITION IEN^PC^STANDARD POSITITION IEN
|
---|
| 166 | I '$P(INFO,U,3) S DATA="1^Role Must be Entered" Q
|
---|
| 167 | I $P(INFO,U,2) I '$P($G(^SD(403.46,+$P(INFO,U,3),0)),U,3) S DATA="1^This Role cannot provide Primary Care" Q
|
---|
| 168 | I $P(INFO,U,2),($P($G(^SD(403.46,+$P(INFO,U,3),0)),U,3)=2) I '$$DATES^SCAPMCU1(404.53,+INFO) S DATA="1^This Role cannot provide Primary Care unless Precepted" Q
|
---|
| 169 | S DATA=0
|
---|
| 170 | I ('INFO)!('$P(INFO,U,2)) Q
|
---|
| 171 | ;Is provider role acceptable?
|
---|
| 172 | S J=-(DT+1) S J=$O(^SCTM(404.52,"AIDT",+INFO,1,J)) Q:J=""
|
---|
| 173 | I $O(^SCTM(404.52,"AIDT",+INFO,0,-(DT+1)))<J Q
|
---|
| 174 | S K=0 S K=$O(^SCTM(404.52,"AIDT",+INFO,1,J,K)) Q:'K
|
---|
| 175 | S ZERO=$G(^SCTM(404.52,+K,0))
|
---|
| 176 | ;Get person class for provider
|
---|
| 177 | S PCLASS=$$GET^XUA4A72(+$P(ZERO,U,3))
|
---|
| 178 | ;IEN^Occupation^specialty^sub-specialty^Effective date^expiration date^VA Code^specialty code
|
---|
| 179 | I '$D(^SD(403.46,+$P(INFO,U,3),2,"B",+PCLASS)) S DATA="1^Person Class of "_$$GET1^DIQ(200,(+$P(ZERO,U,3))_",",.01)_" is not valid in this Role." D POSCHK^SCMCTSK4
|
---|
| 180 | Q
|
---|
| 181 | SEED ;seed one patient/provider
|
---|
| 182 | W !,"To retransmit all patients for a given provider press return to select the provider",!!
|
---|
| 183 | N DIC,SCADT,SCDDT,SCPAI
|
---|
| 184 | S SC177=$$PDAT^SCMCGU("SD*5.3*177")
|
---|
| 185 | I +SC177=0 D Q
|
---|
| 186 | . S SC2=" Unable to obtain SD*5.3*177 Installation Date."
|
---|
| 187 | . D MSG^SCMCCV6(SC1,SC2)
|
---|
| 188 | . Q
|
---|
| 189 | S DIC="^DPT(",DIC(0)="MEQA" D ^DIC G PRSEED:Y'>0
|
---|
| 190 | ;event filer for 1 patient
|
---|
| 191 | S SCDFN=+Y W !,SCDFN
|
---|
| 192 | SCDFN S SC1="^SCPT(404.43,""APCPOS"",SCDFN,1)"
|
---|
| 193 | ;quit if no PC assign
|
---|
| 194 | Q:'$D(@SC1)
|
---|
| 195 | S SCADT=0
|
---|
| 196 | F S SCADT=$O(@SC1@(SCADT)) Q:SCADT="" D
|
---|
| 197 | .S SCTP=0
|
---|
| 198 | .F S SCTP=$O(@SC1@(SCADT,SCTP)) Q:'SCTP D
|
---|
| 199 | ..; quit if team position does not exist
|
---|
| 200 | ..Q:'$D(^SCTM(404.57,SCTP,0))
|
---|
| 201 | ..S SCPAI=0
|
---|
| 202 | ..F S SCPAI=$O(@SC1@(SCADT,SCTP,SCPAI)) Q:'SCPAI D
|
---|
| 203 | ...S SCDDT=$P($G(^SCPT(404.43,SCPAI,0)),U,4)
|
---|
| 204 | ...;quit if not active within date range
|
---|
| 205 | ...Q:$$DTCHK^SCAPU1(SC177,DT,0,SCADT,SCDDT)<1
|
---|
| 206 | ...N SCVAR S SCVAR=SCPAI_";SCPT(404.43,"
|
---|
| 207 | ...;add to HL7 event file
|
---|
| 208 | ...Q:$D(^SCPT(404.48,"AACXMIT",SCVAR))
|
---|
| 209 | ...Q:$$CHECK^SCMCHLB1(SCVAR)'=1
|
---|
| 210 | ...D ADD^SCMCHLE("NOW",SCVAR,SCDFN,SCTP)
|
---|
| 211 | Q
|
---|
| 212 | PRSEED ;seed practitioner
|
---|
| 213 | N AH,SC177
|
---|
| 214 | S SC177=$$PDAT^SCMCGU("SD*5.3*177")
|
---|
| 215 | I +SC177=0 D Q
|
---|
| 216 | . S SC2=" No SD*5.3*177 Installation Date."
|
---|
| 217 | . D MSG^SCMCCV6(SC1,SC2)
|
---|
| 218 | S DIC=200,DIC(0)="MEQA",DIC("A")="Select Provider: " D ^DIC Q:Y'>0
|
---|
| 219 | S SCPROV=+Y
|
---|
| 220 | F AH=0:0 S AH=$O(^SCTM(404.52,"C",SCPROV,AH)) Q:'AH S TP=+$G(^SCTM(404.52,+AH,0)) D
|
---|
| 221 | . Q:$D(SCTP(TP))
|
---|
| 222 | . S SCTP(TP)=1
|
---|
| 223 | . F SCDFN=0:0 S SCDFN=$O(^SCPT(404.43,"ADFN",SCDFN)) Q:'SCDFN I $D(^(SCDFN,TP)) I '$D(SCU(SCDFN)) D SCDFN S SCU(SCDFN)=1
|
---|
| 224 | . Q:'$P($G(^SCTM(404.57,TP,0)),U,4)
|
---|
| 225 | . S SCVAR=AH_";SCTM(404.52,"
|
---|
| 226 | . ;Quit if an event entry already exists
|
---|
| 227 | . N QUIT,I S QUIT=0
|
---|
| 228 | . F I=0:0 S I=$O(^SCPT(404.48,"AACXMIT",SCVAR,I)) Q:'I I $P($G(^SCPT(404.48,I,0)),U,8) S QUIT=1 Q
|
---|
| 229 | . Q:QUIT
|
---|
| 230 | . D ADD^SCMCHLE("NOW",SCVAR,,AH,1)
|
---|
| 231 | Q
|
---|
| 232 | INCON ;inconsistent PC assignments
|
---|
| 233 | N POS
|
---|
| 234 | D INCON^SCMCTSK3
|
---|
| 235 | Q
|
---|
| 236 | INCONR ;inconsistent report
|
---|
| 237 | N BY
|
---|
| 238 | K ^TMP("SCMCTSK",$J)
|
---|
| 239 | S DIC="^SCTM(404.57,",(FLDS,BY)="[SCMC INCONSISTENT]",DIOBEG="D INCON^SCMCTSK1"
|
---|
| 240 | D EN1^DIP
|
---|
| 241 | Q
|
---|
| 242 | INACTDT(PA) ;Scheduled inactivation date.
|
---|
| 243 | D INACT^SCMCTSK3 Q
|
---|
| 244 | IU(DFN) ;is patient inactivity unassigned
|
---|
| 245 | Q $$IU^SCMCTSK3(DFN)
|
---|
| 246 | N I,A,B,DATA
|
---|