source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK9.m@ 1111

Last change on this file since 1111 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.1 KB
Line 
1SCMCTSK9 ;;BP/DMR - PCMM ; 18 Apr 2003 9:36 AM
2 ;;5.3;Scheduling;**297**;AUG 13, 1993
3 Q
4EXTKEY ;
5 N Y,% W @IOF,!,$G(SCDHD) D NOW^%DTC S Y=% W:$X>(IOM-40) ! W ?(IOM-40)
6 W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12)
7 W ?(IOM-15),"PAGE: "_($G(DC)+1)
8 S Y="",$P(Y,"-",IOM)="" W !,Y,!!
9 W !,"Column Heading Explanation of column headings"
10 W !
11 W !,"Patient Name Name of patient scheduled to be inactivated from their primary care team and position/provider."
12 W !,"SSN Patient's last 4 SSN numbers."
13 W !,"Institution Institution name, previously called Division, in which patient receives primary care."
14 W !,"PC Team The patient's assigned Primary Care team in PCMM."
15 W !,"Provider/ Name of Associate Primary Care Provider (AP) assigned to patient, if there is one."
16 W !," Team Position The name of the team position to which the Associate Primary Care Provider (AP) is assigned."
17 W !,"Current Preceptor/ Name of Primary Care Provider (PCP) assigned to patient. Every Primary Care patient should"
18 W !," Team Position be assigned to one PCP. The name of the team position to which the Primary Care Provider (PCP)"
19 W !," is assigned."
20 W !,"Date Scheduled for Date patient will be inactivated from PCMM and their Primary Care team and provider/position unless"
21 W !," Inactivation they have a completed outpatient appointment encounter with their current PCP or AP before this date."
22 W !," Note: There is a patient reassignment option, which allows an inactivated patient to be reactivated"
23 W !," to their previous Primary Care team and position if they return for care."
24 W !,"Reason for Extended The reason entered for extending the patient's time before inactivation from PC panels."
25 W !," Inactivation Entry of this field is in the PCMM GUI, Patient drop down menu, and the Extend Patient's Date for"
26 W !," Inactivation from PC Panels option."
27 Q
28EXTCHUI ;roll n scroll option to extend a patient
29 N DA,DIC,DIE,DR,SCTM,SCARRAY,SCHIGH,SCX,V1
30 S SCTM=0 F D P1 Q:+SCTM<1
31 Q
32P1 D GCL S DIC="^SCTM(404.51,",DIC(0)="AEQMZ" D ^DIC S SCTM=+Y Q:+SCTM<1
33 W !,"Searching...",!
34 D EXTEND(.SCARRAY,SCTM)
35 I $G(^TMP("SCMCTSK9","OUT",$J,1))="<DATA>" W !,"No Patients to Extend..." D GCL Q
36 S SCHIGH=$O(^TMP("SCMCTSK9","OUT",$J,9999999),-1)
37 S SCX=999 F Q:(SCX="^")!(SCX="") D P2
38 Q
39P2 W !,"Select From: ",!!
40 S V1=0 F S V1=$O(^TMP("SCMCTSK9","OUT",$J,V1)) Q:'V1 D
41 . W $J(V1,2)_" ",$P(^TMP("SCMCTSK9","OUT",$J,V1),U,3),!
42 F W !,"Select 1-",SCHIGH," " R SCX:DTIME Q:(SCX="^")!(SCX="")!((SCX'>SCHIGH)&(SCX>0)) D
43 . I $E(SCX,1)="?" W !,"Select 1-",SCHIGH," or '^' to exit" Q
44 . I (+SCX<1)!(+SCX>SCHIGH) W !,"Select a valid number" Q
45 I SCX'?1.9N Q
46 S DIE="^SCPT(404.43,"
47 S DA=$P(^TMP("SCMCTSK9","OUT",$J,SCX),U)
48 S DR=".13//DO NOT EXTEND;S Y=.16 I X=4 S Y=.14;.14;.16////"_DUZ
49 D ^DIE
50 Q
51EXTEND(DATA,SCTEAM) ;return list of patients to inactivate in next 60 days
52 ;IEN^POSITION^PATIENT^EXTENDED^REASON
53 K DATA,SCDATA,SDDATA
54 N CNT,I,J,K,A,POSA S CNT=1 S SCTEAM=$G(SCTEAM),^TMP("SCMCTSK9","OUT",$J,1)="<DATA>"
55 D DT^DICRW S X="T-9M" D ^%DT S STDT=Y
56 S X="T-21M" D ^%DT S TYDT=+Y ;MAKE THIS 21
57 S POSA=""
58 F S POSA=$O(^SCTM(404.57,"ATMPOS",+SCTEAM,POSA)) Q:POSA="" D
59 .F POS=0:0 S POS=$O(^SCTM(404.57,"ATMPOS",+SCTEAM,POSA,POS)) Q:'POS D POS
60EX1 S A="^TMP(""SCMCTSK9"",$J)",CNT=1 F S A=$Q(@A) Q:A=""!($P(A,",",2)'=$J) D
61 .S B=@A
62 .S ^TMP("SCMCTSK9","OUT",$J,CNT)=(+$P(B,U,3))_U_$TR($P($P(A,"(",4),","),$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)
63 .S CNT=CNT+1
64 Q
65POS I '$$DATES^SCAPMCU1(404.59,POS) Q ;Not an active position
66 I '$P($G(^SCTM(404.57,POS,0)),U,4) Q ;Not PC
67 ;get patients for this position
68 K ^TMP("SC TMP LIST",$J)
69 S X=$$PTTP^SCAPMC(POS,"",.SCLIST,.SCERR)
70 S J=0 F S J=$O(@SCLIST@(J)) Q:'J S SCDATA=^(J) D
71 .N J I $P(SCDATA,U,4)>STDT Q
72 .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,5) Q
73 .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,15) Q
74 .S DFN=+SCDATA
75 .D SEEN Q:SEEN
76 .S ^TMP("SCMCTSK9",$J,$P($G(^SCTM(404.57,POS,0)),U),$P(SCDATA,U,2),+SCDATA)=SCDATA,CNT=CNT+1
77 K @SCLIST
78 Q
79SEEN ;was patient seen
80 S SEEN=0
81 N SCPRO,I,PRECP,PRO
82 N X,SCPRDTS,SCPR
83 ;get list of providers for this position
84 S PROV=+$$GETPRTP^SCAPMCU2(POS,DT) S SCPRO(+PROV)=""
85 S SCPRDTS("BEGIN")=TYDT
86 S SCPRDTS("END")=DT
87 S X=$$PRTP^SCAPMC(POS,"SCPRDTS","SCPR")
88 F I=0:0 S I=$O(SCPR(I)) Q:'I S SCPRO(+SCPR(I))=""
89 S PRECP=0 I $G(PREC),$G(PREC)'=POS S PRECP=+$$GETPRTP^SCAPMCU2(PREC,DT),SCPRO(+PRECP)=""
90 F I=TYDT:0 S I=$O(^SCE("ADFN",DFN,I)) Q:'I D Q:SEEN
91 .F J=0:0 S J=$O(^SCE("ADFN",DFN,I,J)) Q:'J D Q:SEEN
92 ..N VISIT S VISIT=+$P($G(^SCE(J,0)),U,5) I $G(^SCE(J,0))<$G(TYDT) Q
93 ..F PRO=0:0 S PRO=$O(SCPRO(PRO)) Q:'PRO D Q:SEEN
94 ...I $D(^SDD(409.44,"AO",J,$G(PRO))) S SEEN=1 Q ;GET THE PROVIDERJ
95 ...N V F V=0:0 S V=$O(^AUPNVPRV("AD",VISIT,V)) Q:'V I PRO=(+$G(^AUPNVPRV(V,0))) S SEEN=1 Q
96 Q
97GCL ;clean temp globals
98 K ^TMP("SCMCTSK9",$J)
99 K ^TMP("SCMCTSK9","OUT",$J)
100 Q
Note: See TracBrowser for help on using the repository browser.