[623] | 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
|
---|