Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPU2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPU2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPU2.m
r613 r623 1 SCRPU2 2 ;;5.3;Scheduling;**41,174,297,526,520**;AUG 13, 1993;Build 26 3 4 DTRANG(FIRST,SECOND) 5 6 7 8 9 10 11 12 13 14 15 16 DEN 17 18 19 20 21 22 23 24 25 26 27 GTEAM(CLN,DFN) 28 29 30 31 F S TPEN=$O(^SCTM(404.57,"E",CLN,TPEN)) Q:TPEN=""!(FOUND) D32 33 34 35 36 37 ASSUN 38 39 40 41 42 43 44 45 46 47 48 49 50 51 PCLNHR() 52 53 54 55 PCLNIN() 56 57 58 59 SUMM() 60 61 62 63 64 YESNO() 65 66 67 68 69 70 71 72 73 PTSTAT 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 HLP2 90 91 92 93 94 HLP 95 96 97 98 99 100 ERR 101 QUIT 102 103 104 SORT() 105 106 107 EN1 108 109 110 111 112 113 114 115 116 HLP3 117 118 119 120 121 122 SORT2() 123 124 ;or [2] Division, Team, SSN 125 126 ;or [4] Division, Team, Practitioner, SSN 127 128 EN4 129 130 131 W !?10,"[2] Division, Team, SSN"132 133 W !?10,"[4] Division, Team, Practitioner, SSN"134 135 136 137 138 139 140 HLP4 141 142 143 W !?10,"- 2 to sort by Division, Team, SSN"144 145 W !?10,"- 4 to sort by Division, Team, Practitioner, SSN"146 1 SCRPU2 ;ALB/CMM - GENERIC PROMPTS FOR PCMM REPORTS ; 12 Jan 99 1:23 PM 2 ;;5.3;Scheduling;**41,174,297**;AUG 13, 1993 3 ; 4 DTRANG(FIRST,SECOND) ;Date Range - begin date ^ end date => fileman format 5 ;FIRST - first prompt (not required) 6 ;SECOND - second prompt (not required) 7 N BDATE,EDATE,DIROUT,DUOUT,DTOUT 8 S EDATE=-1 9 S DIR(0)="D^::E",DIR("B")="Today" 10 I '$D(FIRST) S DIR("A")="Begin Date" 11 I $D(FIRST) S DIR("A")=FIRST 12 D ^DIR 13 I $D(DTOUT)!(X="Today") S BDATE=$P(DT,".") 14 I $D(DUOUT)!($D(DIROUT)) Q -1 15 S BDATE=+Y 16 DEN I '$D(SECOND) S DIR("A")="End Date" 17 I $D(SECOND) S DIR("A")=SECOND 18 K DTOUT,X,Y 19 D ^DIR 20 I $D(DTOUT)!(X="Today") S EDATE=$P(DT,".") 21 I $D(DUOUT)!($D(DIROUT)) Q -1 22 S EDATE=+Y 23 I EDATE<BDATE W !,"End date can't occur before Begin Date",! G DEN 24 K X,Y,DIR 25 Q BDATE_"^"_EDATE 26 ; 27 GTEAM(CLN,DFN) ; 28 ;given clinic and patient, find related team 29 N TPEN,FOUND,TEAM 30 S TPEN="",FOUND=0 31 F S TPEN=$O(^SCTM(404.57,"D",CLN,TPEN)) Q:TPEN=""!(FOUND) D 32 .S TEAM=$P(^SCTM(404.57,TPEN,0),"^",2) 33 .I $D(^SCPT(404.42,"APTTM",DFN,TEAM)) S FOUND=1 34 I FOUND=1 Q TEAM 35 Q FOUND 36 ; 37 ASSUN ; 38 ;prompt for assigned or unassigned to Primary Care Team 39 N VAUTVB 40 S VAUTVB="VAUTA" 41 W !,"(A)ssigned or (U)nassigned Patients to Primary Care Team: " 42 R X:DTIME 43 I (X="^")!'$T G ERR 44 I (X'="A")&(X'="U") D HLP G ASSUN 45 I (X="")!(X["?") D HLP G ASSUN 46 I X="A" S @VAUTVB=1 47 I X="U" S @VAUTVB=0 48 K X 49 Q 50 ; 51 PCLNHR() ;Prompt to Print Clinic Hours 52 S DIR("A")="Print Clinic Hours",DIR("B")="Y" 53 Q $$YESNO() 54 ; 55 PCLNIN() ;Prompt to Print Clinic Information 56 S DIR("A")="Print Clinic Information",DIR("B")="Y" 57 Q $$YESNO() 58 ; 59 SUMM() ;Prompt to Print Summary Only (y/n) 60 S DIR("A")="Print Summary Only",DIR("B")="N" 61 S DIR("?")="Enter 'Y' to have patient names excluded, 'N' to include patient names" 62 Q $$YESNO() 63 ; 64 YESNO() ;Yes/No prompt 65 N X,DTOUT,DUOUT,DIROUT,Y 66 S DIR(0)="Y" 67 D ^DIR 68 I $D(DTOUT)!(X="") S Y=$S(DIR("B")="Y":1,1:0) 69 I $D(DUOUT)!($D(DIROUT)) S Y=-1 70 K DIR 71 Q +Y 72 ; 73 PTSTAT ;Prompt for Patient Status (All, OPT, AC) 74 ;Modified by patch 172 75 S VAUTPS=1 Q 76 ; 77 N X,STAT,VAUTVB 78 S VAUTVB="VAUTPS" 79 W !,"Patient Status: ALL//" 80 R X:DTIME 81 I '$T!(X="")!(X="ALL") S @VAUTVB=1 82 I X="^" G ERR 83 I (X["?") D HLP2 G PTSTAT 84 I X="A"!(X="AC") S @VAUTVB="AC" 85 I X="O"!(X="OPT") S @VAUTVB="OPT" 86 I '$D(@VAUTVB) D HLP2 G PTSTAT 87 Q 88 ; 89 HLP2 ;help prompt for Patient Status 90 W !,"Enter: ",!?10,"- A or AC for patients whose status is AC" 91 W !?10,"- O or OPT for patient whose status is OPT" 92 W !?10,"- Enter or ALL for both AC and OPT patients" 93 Q 94 HLP ; 95 ;help prompt 96 W !,"Enter: ",!?5,"- A for patients assigned to the team as Primary Care" 97 W !?10,"- U for patients not assigned to the team as Primary Care" 98 Q 99 ; 100 ERR S Y=-1 I $O(@VAUTVB@(0))="" K @VAUTVB 101 QUIT S:'$D(Y) Y=1 K DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNI,VAUTSTR,VAUTVB,X 102 Q 103 ; 104 SORT() ; 105 ;Prompt for sorting by Division, Team, Practitioner or Division, Practitioner, Team 106 ; 107 EN1 N X 108 W !,"Sort By:",!?10,"[1] Division, Team, Practitioner",!?10,"[2] Division, Practitioner, Team" 109 W !?10,"[3] Practitioner,Associated Clinic" 110 W !!,"Select 1 or 2 or 3: " 111 R X:DTIME 112 I (X="^")!'$T Q 0 113 I (X'="1")&(X'="2")&(X'=3) D HLP3 G EN1 114 I (X["?")!(X="") D HLP3 G EN1 115 Q X 116 HLP3 ; 117 ;help prompt 118 W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Practitioner " 119 W !?10,"- 2 to sort by Division, Practitioner, Team" 120 Q 121 ; 122 SORT2() ;Prompt for sorting by: 123 ; [1] Division, Team, Patient Name 124 ;or [2] Division, Team, Last 4 Pt ID 125 ;or [3] Division, Team, Practitioner, Patient Name 126 ;or [4] Division, Team, Practitioner, Last 4 Pt ID 127 ; 128 EN4 ; 129 N X 130 W !,"Sort By:",!?10,"[1] Division, Team, Patient Name" 131 W !?10,"[2] Division, Team, Last 4 Pt ID" 132 W !?10,"[3] Division, Team, Practitioner, Patient Name" 133 W !?10,"[4] Division, Team, Practitioner, Last 4 Pt ID" 134 W !!,"Select 1, 2, 3, or 4: " 135 R X:DTIME 136 I X=""!(X="^")!'$T Q 0 137 I (X'="1")&(X'="2")&(X'="3")&(X'="4") D HLP4 G EN4 138 I (X["?") D HLP4 G EN4 139 Q X 140 HLP4 ; 141 ;help prompt 142 W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Patient Name" 143 W !?10,"- 2 to sort by Division, Team, Last 4 Pt ID" 144 W !?10,"- 3 to sort by Division, Team, Practitioner, Patient Name" 145 W !?10,"- 4 to sort by Division, Team, Practitioner, Last 4 Pt ID" 146 Q
Note:
See TracChangeset
for help on using the changeset viewer.
