Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK9.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK9.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCTSK9.m
r613 r623 1 SCMCTSK9 2 ;;5.3;Scheduling;**297,526**;AUG 13, 1993;Build 8 3 4 EXTKEY 5 6 7 8 9 10 11 12 W !,"SSN SSN number."13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 EXTCHUI 29 30 31 32 P1 33 34 35 36 37 38 39 P2 40 41 42 43 44 45 46 47 48 49 50 51 EXTEND(DATA,SCTEAM) 52 53 54 55 56 57 58 59 60 EX1 61 62 63 64 65 POS 66 67 68 69 70 71 72 73 74 75 76 77 78 79 SEEN 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 GCL 98 99 100 1 SCMCTSK9 ;;BP/DMR - PCMM ; 18 Apr 2003 9:36 AM 2 ;;5.3;Scheduling;**297**;AUG 13, 1993 3 Q 4 EXTKEY ; 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 28 EXTCHUI ;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 32 P1 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 39 P2 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 51 EXTEND(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 60 EX1 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 65 POS 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 79 SEEN ;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 97 GCL ;clean temp globals 98 K ^TMP("SCMCTSK9",$J) 99 K ^TMP("SCMCTSK9","OUT",$J) 100 Q
Note:
See TracChangeset
for help on using the changeset viewer.
