source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK6.m@ 1305

SCMCTSK6 ;ALB/JDS - PCMM Bulletins ; 7/19/05 10:04am
 ;;5.3;Scheduling;**297**;AUG 13, 1993
 Q
MAKEMAIL(TYPE)  ;
 N PRE,IN
 S ZERO=$G(^SCPT(404.43,+ENTRY,0)),ZERO1=$G(^SCPT(404.42,+ZERO,0))
 S T=+$P(ZERO1,U,3),IN=$P($G(^SCTM(404.51,T,0)),U,7) S INSTNM=$$GET1^DIQ(4,(+IN)_",",.01)
 I INSTNM'=DIV S DIV=INSTNM D
 .S ^TMP("SCMCTXT",$J,CNT,0)="  "
 .S ^TMP("SCMCTXT",$J,CNT+1,0)="      INSTITUTION: "_DIV,CNT=CNT+2
 S PROV=$P($$GETPRTP^SCAPMCU2(+$P(ZERO,U,2),DT),U,2)
 S PRE=$P($$OKPREC2^SCMCLK(+$P(ZERO,U,2),DT),U,2)
 S A=$E($$NAME^SCMCQK1(+ZERO1)_$J("",30),1,20)_" "_$E($$GET1^DIQ(2,(+ZERO1)_",",.0905)_$J("",5),2,5)_" "
 S A=A_$E(PROV_$J("",20),1,17)_" "_$E($E($$TEAMNM^SCMCQK1(+$P(ZERO1,U,3)),1,14)_$J("",20),1,15)
 ;S A=A_" "_$E($$POSITION^SCMCQK1(+$P(ZERO,U,2))_$J("",20),1,20)
 D INACTDT^SCMCTSK1(+ENTRY) S Y=X S:$G(TYPE)=2 Y=$P(ZERO,U,4),Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),A=A_$E(Y_$J("",20),1,11)
 I $G(TYPE)=3 S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) S A=A_" "_$E(Y_$J("",20),1,11)
 I $G(TYPE)=1 S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) S A=A_" "_$E(Y_$J("",20),1,11)
 I $G(TYPE)=2 S B=$P(ZERO,U,12),A=A_" "_$S(B="NA":"NO APPT",B="DU":"DECEASED",1:"Unknown")
 S ^TMP("SCMCTXT",$J,CNT,0)=A
 I PRE'=PROV I $L(PRE) S CNT=CNT+1,^TMP("SCMCTXT",$J,CNT,0)=$J("",26)_$E(PRE,1,17)
 S CNT=CNT+1
 Q
MM(TYPE)        ;for providers
 N EXP
 S Y=$P($G(^SCTM(404.44,1,1)),U,9)
 S EXP=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
 S ZERO=$G(^SCTM(404.52,+ENTRY,0)) N CLI
 S TP=$G(^SCTM(404.57,+ZERO,0)) D MAIL^SCMCTSK5(+ZERO,+$P(TP,U,2)) S T=$P(TP,U,2)
 S ^TMP("SCML",$J,"POS",+$P(ZERO,U,3))=""
 S ^TMP("SCML",$J,"XM",+$P(ZERO,U,3),+ZERO)=""
 I TYPE=5 S Y=$P(ZERO,U,2),EXP=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
 S IN=$P($G(^SCTM(404.51,T,0)),U,7) S INSTNM=$$GET1^DIQ(4,(+IN)_",",.01)
 I INSTNM'=DIV S DIV=INSTNM D
 .S ^TMP("SCMCTXT",$J,CNT,0)="   "
 .S ^TMP("SCMCTXT",$J,CNT+1,0)="      INSTITUTION: "_DIV,CNT=CNT+2
 N I,CNT1 S CNT1=0
 S ROLE=$P($G(^SD(403.46,+$P(TP,U,3),0)),U)
 S PC=$P($$GET^XUA4A72(+$P(ZERO,U,3)),U,2)
 I $G(^TMP("SCMCTXT",$J,3,0))["|POS|" S A=^(0),^(0)=$P(A,"|POS|")_$P(TP,U)_" ROLE: "_ROLE D
 .S A=$G(^TMP("SCMCTXT",$J,5,0)),^(0)=$P(A,"|PC|")_PC
 F I=0:0 S I=$O(^SCTM(404.57,+ZERO,5,I)) Q:'I  S CLI(CNT1)=$P($G(^SC(I,0)),U),CNT1=CNT1+1
 S A=$E($P($G(^VA(200,+$P(ZERO,U,3),0)),U)_$J("",20),1,14)_" "_$E($G(CLI(0))_$J("",10),1,9)
 S A=A_" "_$E($P(TP,U)_$J("",20),1,10)_" "_$E(ROLE_$J("",20),1,14)
 S A=A_" "_$E(PC_$J("",20),1,14)
 S A=A_" "_$E($$PCPOSCNT^SCAPMCU1(+ZERO,DT,0)_$J("",9),1,4)_" "_EXP
 S ^TMP("SCMCTXT",$J,CNT,0)=A
 F I=1:1 Q:'$D(CLI(I))  I $L(CLI(I)) S CNT=CNT+1,^TMP("SCMCTXT",$J,CNT,0)=$J("",15)_$E(CLI(I),1,9)
 S CNT=CNT+1
 Q
PRMAIL(TYPE)    ;
 ;Send mail to providers
 N USER
 F USER=0:0 S USER=$O(^TMP("SCML",$J,"XM",USER)) Q:'USER  D
 .F I=HEAD:0 S I=$O(^TMP("SCMCTXT",$J,I)) Q:'I  K ^(I)
 .I TYPE=5 D M5
 .S CNT=HEAD,DIV=""
 .F I=0:0 S I=$O(^TMP("SCMC",$J,I)) Q:'I  S ENTRY=+$O(^(I,0)) D
 ..S ZERO=$G(^SCPT(404.43,+ENTRY,0)),ZERO1=$G(^SCPT(404.42,+ZERO,0))
 ..I TYPE>3 D  Q
 ...S ZERO=$G(^SCTM(404.52,+ENTRY,0))
 ...I $D(^TMP("SCML",$J,"XM",USER,+ZERO)) D MM(TYPE)
 ..I $D(^TMP("SCML",$J,"XM",USER,+$P(ZERO,U,2))) D MAKEMAIL(TYPE)
 .I CNT=HEAD Q
 .S XMY(USER)="",XMTEXT="^TMP(""SCMCTXT"",$J,"
 .S XMSUB="Patients Scheduled for Inactivation from Primary Care Panel"
 .I TYPE=3 S XMSUB="Patients With Extended PCMM Inactivation Date"
 .I TYPE=2 S XMSUB="Patients Automated Inactivations from Primary Care Panels"
 .I TYPE=4 S XMSUB="Primary Care Providers Scheduled for Inactivation"
 .I TYPE=5 S XMSUB="Primary Care Providers Inactivated"
 .D ^XMD
 Q
M5 ;Individual provider bulletin
 Q:$G(^TMP("SCMCTXT",$J,1,0))["ATTENTION"
 F I=1:1:CNT-1 Q:'$D(^TMP("SCMCTXT",$J,I))  S A=^(I,0),^TMP("SCMCTXT",$J,I+11,0)=A
 F I=0:1:10 S A=$P($T(M6+I),";;",2),^TMP("SCMCTXT",$J,I+1,0)=A
 S HEAD=HEAD+12
 Q
M6 ;;ATTENTION: You may be inactivated as Primary Care Staff in the computer program
 ;;Primary Care Management Module (PCMM) VistA
 ;;Your Primary Care position |POS|       Role |ROLE|
 ;;May not correspond to your Person Class of
 ;;|PC|
 ;;in VistA (file 200). Associate Primary Care Providers who provide Primary Care
 ;;must be a Resident or Intern (Physician) a Nurse Practitioner or a Physician's
 ;;Assistant. Primary Care Providers must be an Attending physician (MD or DO),
 ;;Nurse Practitioner or a Physician's Assistant
 ;;Please contact your PCMM Coordinator or information systems department if you
 ;;do not think you should be inactivated in PCMM as a provider.
 Q
ACLIN ;Get sting of clinics in Alpha Order
 S X=""
 N A,I
 F I=0:0 S I=$O(^SCTM(404.57,+$G(D0),5,I)) Q:'I  S A=$P($G(^SC(I,0)),U) I $L(A) S A(A)=""
 S A="" F  S A=$O(A(A)) Q:A=""  S X=X_$E(A,1,5)_U
 S X=$P(X,U,1,$S(X[U:$L(X,U)-1,1:1))
 Q
BULL ;
 N FLDS
 S DISUPNO=1
 K ^TMP("SCMC",$J),^TMP("SCMCTXT",$J),^TMP("SCML",$J),XMY
 S XMY("G.PCMM PATIENT/PROVIDER INACTIVE")=""
 S XMTEXT="^TMP(""SCMCTXT"",$J,"
 S DIC="^SCTM(404.52,",BY="[SCMC PROVIDER INACTIVATED]",DHIT="S CNT=$G(CNT)+1,^TMP(""SCMC"",$J,CNT,D0)=""""",CNT=0
 S FLDS="",IOP="",DHD="@@",FR="",TO="" D EN1^DIP
 S XMSUB="Primary Care Providers Inactivated"
 D LINES^SCMCTSK5(5)
 D ^XMD
 D PRMAIL^SCMCTSK5(5)
 Q
FTERPT   ;FTEE REPORT
 D PROMPT^SCMCTSK3("DIRECT PC FTEE-PANEL SIZE")
 Q:'$D(^TMP("SC",$J,"XR"))
 ;D FLAGG^SCMCTSK3
 S Q=""""
 S DIC="^SCTM(404.52,",L=0
 D FTEE
 S (SCDHD,DHD)="DIRECT PC FTEE AND PANEL SIZE REPORT"
 D BY^SCMCTSK2
 S DIOBEG="D DIOBEG^SCMCTSK4"
 S FLDS="[SCMC DIRECT PC FTEE]"
 I $D(^TMP("SC",$J,"SCLIN")) S FLDS="[SCMC DIRECT PC FTEE 1 CLN]"
 S DIOEND="D DIOEND^SCMCTSK7"
 D EN1^DIP
 Q
FTEE ;Sort FLAGGED
 K ^TMP("SCSORT",$J)
 N I,A,J
 I '$D(^TMP("SC",$J,"SORT",1)) S ^(1)="DV^INSTITUTION^SCDIV",SORTN="INSTITUTION",^(2)="TM^TEAM^SCTEAM",^(3)="PR^PROVIDER^SCPROV"
 N SORT S A="" F  S A=$O(^TMP("SC",$J,A)) Q:A=""  I "XRSORTDTR"'[A I $G(^(A))'="ALL" S SORT($S(A="ASPR":"PR",A="CLINIC":"EC",A="DIV":"DV",A="POS":"TP",1:"TM"))=""
 F I=0:0 S I=$O(^SCTM(404.52,"AIDT",I)) Q:'I  S K=$O(^SCTM(404.52,"AIDT",I,1,-9999999)) I K D
 .I $O(^SCTM(404.52,"AIDT",I,0,K),-1) Q   ;inactive
 .S J=$O(^SCTM(404.52,"AIDT",I,1,K,0)) Q:'J
 .D SORT(0)
 Q
SORT(INACTIVE)  ;
 N A,B,C,D,E,QUIT,SCA,K,KCNT
 S ZERO=$G(^SCTM(404.52,+J,0))
 S QUIT=0,KCNT=0
 F K=1:1 Q:'$D(^TMP("SC",$J,"SORT",K))  S A=^(K) K SORT($P(A,U)) S @("A("_K_")=$$"_$P(A,U)_"("_J_")") D  I (A(K)=-1)!($P(A(K),U)="") S QUIT=1 Q
 .I ($P(A,U)="EC")!($P(A,U)="AC") D
 ..I $L(A(K),U)>2 S KCNT=K
 ..N I F I=1:1:$L(A(K),U)-1 S ^TMP("SC",$J,"SCLIN",+ZERO,$P(A(K),U,I))=""
 Q:QUIT
 S A="" F  S A=$O(SORT(A)) Q:A=""  S @("B=$$"_A_"("_J_")") I B=-1 S QUIT=1 Q
 Q:QUIT
 F PIECE=1:1:$S(KCNT:$L(A(KCNT),U)-1,1:1) D
 .S B="E" K @B
 .F K=1:1:$O(A(99),-1) S @B@($P(A(K),U,$S(K=KCNT:PIECE,1:1)))="" S C=$Q(@B) K @B S B=C
 .S @B@(J)=""
 .M ^TMP("SCSORT",$J)=E
 Q
DV(PP)       ;return institution sort of patient assignment entry and then IEN of team^ien of position
 N A,B,C,T,I,INSTNM,INSTN
 S T=+$P($G(^SCTM(404.57,+ZERO,0)),U,2) I $D(INST(T)) Q INST(T)_U_T_U_(+ZERO)
 S I=+$P($G(^SCTM(404.51,T,0)),U,7) I $O(^TMP("SC",$J,"DIV",0)) I '$D(^TMP("SC",$J,"DIV",I)) Q -1
 S INSTNM=$$GET1^DIQ(4,(+I)_",",.01),INSTN=$$GET1^DIQ(4,(+I)_",",99)
 S INST(T)=$S($L(INSTN)=3:INSTN_" ",1:"")_INSTNM Q INST(T)_U_T_U_(+ZERO)
EC(PP) Q $$AC(PP)
AC(PP)     ;return enrolled clinics
 N I,A
 S A=""
 F I=0:0 S I=$O(^SCTM(404.57,+ZERO,5,I)) Q:'I  D
 .;I '$$PTCL^SCRPO2(DFN,U_I,0,DT) Q   ;not enrolled
 .I $D(CLIN(I)) S A=A_CLIN(I)_U Q
 .I $O(^TMP("SC",$J,"CLINIC",0)) I '$D(^(I)) Q
 .S CLIN(I)=$P($G(^SC(I,0)),U) I $L(CLIN(I)) S A=A_CLIN(I)_U
 Q $S(A="":-1,1:A)
TM(PP) ;Return Team
 N I,A,T
 S T=+$P($G(^SCTM(404.57,+ZERO,0)),U,2)
 I $D(TEAM(T)) Q TEAM(T)
 I $O(^TMP("SC",$J,"TEAM",0)) I '$D(^(T)) Q -1
 S TEAM(T)=$P($G(^SCTM(404.51,+T,0)),U)
 I '$L(TEAM(T)) K TEAM(T) Q -1
 Q TEAM(T)
TP(A) ;return the team position
 N TP S TP=+ZERO
 I $O(^TMP("SC",$J,"POS",0)) I '$D(^(TP)) Q -1
 Q $P($G(^SCTM(404.57,+TP,0)),U)
PR(PP)  ;Return assigned provider
 N A
 I $O(^TMP("SC",$J,"ASPR",0)) I '$D(^(+$P(ZERO,U,3))) Q -1
 S A=$$GET1^DIQ(200,(+$P(ZERO,U,3))_",",.01) Q $S(A="":-1,1:A)
 Q
PCP(D0) ;PCP or AP
 N TP,A S TP=+$G(^SCTM(404.52,D0,0))
 S A=$O(^SCTM(404.53,"AIDT",TP,1,0),-1) I 'A Q "PCP"
 I $O(^SCTM(404.53,"AIDT",TP,0,A),-1) Q "PCP"
 Q "AP"
CLN(D0) ;sorted by clinic get next one
 N A S A=$O(^TMP("SC",$J,"SCLIN",D0,"")) Q:A=""
 N I F I=0:0 S I=$O(^SC("B",A,I)) Q:'I  I $D(^SCTM(404.57,D0,5,I)) Q
 Q:'I
 S DIPA("NUM")="`"_I K ^TMP("SC",$J,"SCLIN",D0,A)