SCRPU2 ;ALB/CMM - GENERIC PROMPTS FOR PCMM REPORTS ; 12 Jan 99 1:23 PM
;;5.3;Scheduling;**41,174,297,526,520,1015**;AUG 13, 1993;Build 21
;IHS/ANMC/LJF 11/03/2000 changed Last 4 of PID to Chart #
;
DTRANG(FIRST,SECOND) ;Date Range - begin date ^ end date => fileman format
;FIRST - first prompt (not required)
;SECOND - second prompt (not required)
N BDATE,EDATE,DIROUT,DUOUT,DTOUT
S EDATE=-1
S DIR(0)="D^::E",DIR("B")="Today"
I '$D(FIRST) S DIR("A")="Begin Date"
I $D(FIRST) S DIR("A")=FIRST
D ^DIR
I $D(DTOUT)!(X="Today") S BDATE=$P(DT,".")
I $D(DUOUT)!($D(DIROUT)) Q -1
S BDATE=+Y
DEN I '$D(SECOND) S DIR("A")="End Date"
I $D(SECOND) S DIR("A")=SECOND
K DTOUT,X,Y
D ^DIR
I $D(DTOUT)!(X="Today") S EDATE=$P(DT,".")
I $D(DUOUT)!($D(DIROUT)) Q -1
S EDATE=+Y
I EDATE<BDATE W !,"End date can't occur before Begin Date",! G DEN
K X,Y,DIR
Q BDATE_"^"_EDATE
;
GTEAM(CLN,DFN) ;
;given clinic and patient, find related team
N TPEN,FOUND,TEAM
S TPEN="",FOUND=0
F S TPEN=$O(^SCTM(404.57,"E",CLN,TPEN)) Q:TPEN=""!(FOUND) D
.S TEAM=$P(^SCTM(404.57,TPEN,0),"^",2)
.I $D(^SCPT(404.42,"APTTM",DFN,TEAM)) S FOUND=1
I FOUND=1 Q TEAM
Q FOUND
;
ASSUN ;
;prompt for assigned or unassigned to Primary Care Team
N VAUTVB
S VAUTVB="VAUTA"
W !,"(A)ssigned or (U)nassigned Patients to Primary Care Team: "
R X:DTIME
I (X="^")!'$T G ERR
I (X'="A")&(X'="U") D HLP G ASSUN
I (X="")!(X["?") D HLP G ASSUN
I X="A" S @VAUTVB=1
I X="U" S @VAUTVB=0
K X
Q
;
PCLNHR() ;Prompt to Print Clinic Hours
S DIR("A")="Print Clinic Hours",DIR("B")="Y"
Q $$YESNO()
;
PCLNIN() ;Prompt to Print Clinic Information
S DIR("A")="Print Clinic Information",DIR("B")="Y"
Q $$YESNO()
;
SUMM() ;Prompt to Print Summary Only (y/n)
S DIR("A")="Print Summary Only",DIR("B")="N"
S DIR("?")="Enter 'Y' to have patient names excluded, 'N' to include patient names"
Q $$YESNO()
;
YESNO() ;Yes/No prompt
N X,DTOUT,DUOUT,DIROUT,Y
S DIR(0)="Y"
D ^DIR
I $D(DTOUT)!(X="") S Y=$S(DIR("B")="Y":1,1:0)
I $D(DUOUT)!($D(DIROUT)) S Y=-1
K DIR
Q +Y
;
PTSTAT ;Prompt for Patient Status (All, OPT, AC)
;Modified by patch 172
S VAUTPS=1 Q
;
N X,STAT,VAUTVB
S VAUTVB="VAUTPS"
W !,"Patient Status: ALL//"
R X:DTIME
I '$T!(X="")!(X="ALL") S @VAUTVB=1
I X="^" G ERR
I (X["?") D HLP2 G PTSTAT
I X="A"!(X="AC") S @VAUTVB="AC"
I X="O"!(X="OPT") S @VAUTVB="OPT"
I '$D(@VAUTVB) D HLP2 G PTSTAT
Q
;
HLP2 ;help prompt for Patient Status
W !,"Enter: ",!?10,"- A or AC for patients whose status is AC"
W !?10,"- O or OPT for patient whose status is OPT"
W !?10,"- Enter or ALL for both AC and OPT patients"
Q
HLP ;
;help prompt
W !,"Enter: ",!?5,"- A for patients assigned to the team as Primary Care"
W !?10,"- U for patients not assigned to the team as Primary Care"
Q
;
ERR S Y=-1 I $O(@VAUTVB@(0))="" K @VAUTVB
QUIT S:'$D(Y) Y=1 K DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNI,VAUTSTR,VAUTVB,X
Q
;
SORT() ;
;Prompt for sorting by Division, Team, Practitioner or Division, Practitioner, Team
;
EN1 N X
W !,"Sort By:",!?10,"[1] Division, Team, Practitioner",!?10,"[2] Division, Practitioner, Team"
W !?10,"[3] Practitioner,Associated Clinic"
W !!,"Select 1 or 2 or 3: "
R X:DTIME
I (X="^")!'$T Q 0
I (X'="1")&(X'="2")&(X'=3) D HLP3 G EN1
I (X["?")!(X="") D HLP3 G EN1
Q X
HLP3 ;
;help prompt
W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Practitioner "
W !?10,"- 2 to sort by Division, Practitioner, Team"
Q
;
SORT2() ;Prompt for sorting by:
; [1] Division, Team, Patient Name
;or [2] Division, Team, SSN
;or [3] Division, Team, Practitioner, Patient Name
;or [4] Division, Team, Practitioner, SSN
;
EN4 ;
N X
W !,"Sort By:",!?10,"[1] Division, Team, Patient Name"
;W !?10,"[2] Division, Team, SSN"
W !?10,"[2] Division, Team, Chart #" ;IHS/ANMC/LJF 11/03/2000
W !?10,"[3] Division, Team, Practitioner, Patient Name"
;W !?10,"[4] Division, Team, Practitioner, SSN"
W !?10,"[4] Division, Team, Practitioner, Chart #" ;IHS/ANMC/LJF 11/03/2000
W !!,"Select 1, 2, 3, or 4: "
R X:DTIME
I X=""!(X="^")!'$T Q 0
I (X'="1")&(X'="2")&(X'="3")&(X'="4") D HLP4 G EN4
I (X["?") D HLP4 G EN4
Q X
HLP4 ;
;help prompt
W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Patient Name"
W !?10,"- 2 to sort by Division, Team, Chart #" ;IHS/ANMC/LJF 11/03/2000
;W !?10,"- 2 to sort by Division, Team, SSN"
W !?10,"- 3 to sort by Division, Team, Practitioner, Patient Name"
;W !?10,"- 4 to sort by Division, Team, Practitioner, SSN"
W !?10,"- 4 to sort by Division, Team, Practitioner, Chart #" ;IHS/ANMC/LJF 11/03/2000
Q
SCRPU2 ;ALB/CMM - GENERIC PROMPTS FOR PCMM REPORTS ; 12 Jan 99 1:23 PM
+1 ;;5.3;Scheduling;**41,174,297,526,520,1015**;AUG 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 11/03/2000 changed Last 4 of PID to Chart #
+3 ;
DTRANG(FIRST,SECOND) ;Date Range - begin date ^ end date => fileman format
+1 ;FIRST - first prompt (not required)
+2 ;SECOND - second prompt (not required)
+3 NEW BDATE,EDATE,DIROUT,DUOUT,DTOUT
+4 SET EDATE=-1
+5 SET DIR(0)="D^::E"
SET DIR("B")="Today"
+6 IF '$DATA(FIRST)
SET DIR("A")="Begin Date"
+7 IF $DATA(FIRST)
SET DIR("A")=FIRST
+8 DO ^DIR
+9 IF $DATA(DTOUT)!(X="Today")
SET BDATE=$PIECE(DT,".")
+10 IF $DATA(DUOUT)!($DATA(DIROUT))
QUIT -1
+11 SET BDATE=+Y
DEN IF '$DATA(SECOND)
SET DIR("A")="End Date"
+1 IF $DATA(SECOND)
SET DIR("A")=SECOND
+2 KILL DTOUT,X,Y
+3 DO ^DIR
+4 IF $DATA(DTOUT)!(X="Today")
SET EDATE=$PIECE(DT,".")
+5 IF $DATA(DUOUT)!($DATA(DIROUT))
QUIT -1
+6 SET EDATE=+Y
+7 IF EDATE<BDATE
WRITE !,"End date can't occur before Begin Date",!
GOTO DEN
+8 KILL X,Y,DIR
+9 QUIT BDATE_"^"_EDATE
+10 ;
GTEAM(CLN,DFN) ;
+1 ;given clinic and patient, find related team
+2 NEW TPEN,FOUND,TEAM
+3 SET TPEN=""
SET FOUND=0
+4 FOR
SET TPEN=$ORDER(^SCTM(404.57,"E",CLN,TPEN))
IF TPEN=""!(FOUND)
QUIT
Begin DoDot:1
+5 SET TEAM=$PIECE(^SCTM(404.57,TPEN,0),"^",2)
+6 IF $DATA(^SCPT(404.42,"APTTM",DFN,TEAM))
SET FOUND=1
End DoDot:1
+7 IF FOUND=1
QUIT TEAM
+8 QUIT FOUND
+9 ;
ASSUN ;
+1 ;prompt for assigned or unassigned to Primary Care Team
+2 NEW VAUTVB
+3 SET VAUTVB="VAUTA"
+4 WRITE !,"(A)ssigned or (U)nassigned Patients to Primary Care Team: "
+5 READ X:DTIME
+6 IF (X="^")!'$TEST
GOTO ERR
+7 IF (X'="A")&(X'="U")
DO HLP
GOTO ASSUN
+8 IF (X="")!(X["?")
DO HLP
GOTO ASSUN
+9 IF X="A"
SET @VAUTVB=1
+10 IF X="U"
SET @VAUTVB=0
+11 KILL X
+12 QUIT
+13 ;
PCLNHR() ;Prompt to Print Clinic Hours
+1 SET DIR("A")="Print Clinic Hours"
SET DIR("B")="Y"
+2 QUIT $$YESNO()
+3 ;
PCLNIN() ;Prompt to Print Clinic Information
+1 SET DIR("A")="Print Clinic Information"
SET DIR("B")="Y"
+2 QUIT $$YESNO()
+3 ;
SUMM() ;Prompt to Print Summary Only (y/n)
+1 SET DIR("A")="Print Summary Only"
SET DIR("B")="N"
+2 SET DIR("?")="Enter 'Y' to have patient names excluded, 'N' to include patient names"
+3 QUIT $$YESNO()
+4 ;
YESNO() ;Yes/No prompt
+1 NEW X,DTOUT,DUOUT,DIROUT,Y
+2 SET DIR(0)="Y"
+3 DO ^DIR
+4 IF $DATA(DTOUT)!(X="")
SET Y=$SELECT(DIR("B")="Y":1,1:0)
+5 IF $DATA(DUOUT)!($DATA(DIROUT))
SET Y=-1
+6 KILL DIR
+7 QUIT +Y
+8 ;
PTSTAT ;Prompt for Patient Status (All, OPT, AC)
+1 ;Modified by patch 172
+2 SET VAUTPS=1
QUIT
+3 ;
+4 NEW X,STAT,VAUTVB
+5 SET VAUTVB="VAUTPS"
+6 WRITE !,"Patient Status: ALL//"
+7 READ X:DTIME
+8 IF '$TEST!(X="")!(X="ALL")
SET @VAUTVB=1
+9 IF X="^"
GOTO ERR
+10 IF (X["?")
DO HLP2
GOTO PTSTAT
+11 IF X="A"!(X="AC")
SET @VAUTVB="AC"
+12 IF X="O"!(X="OPT")
SET @VAUTVB="OPT"
+13 IF '$DATA(@VAUTVB)
DO HLP2
GOTO PTSTAT
+14 QUIT
+15 ;
HLP2 ;help prompt for Patient Status
+1 WRITE !,"Enter: ",!?10,"- A or AC for patients whose status is AC"
+2 WRITE !?10,"- O or OPT for patient whose status is OPT"
+3 WRITE !?10,"- Enter or ALL for both AC and OPT patients"
+4 QUIT
HLP ;
+1 ;help prompt
+2 WRITE !,"Enter: ",!?5,"- A for patients assigned to the team as Primary Care"
+3 WRITE !?10,"- U for patients not assigned to the team as Primary Care"
+4 QUIT
+5 ;
ERR SET Y=-1
IF $ORDER(@VAUTVB@(0))=""
KILL @VAUTVB
QUIT IF '$DATA(Y)
SET Y=1
KILL DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNI,VAUTSTR,VAUTVB,X
+1 QUIT
+2 ;
SORT() ;
+1 ;Prompt for sorting by Division, Team, Practitioner or Division, Practitioner, Team
+2 ;
EN1 NEW X
+1 WRITE !,"Sort By:",!?10,"[1] Division, Team, Practitioner",!?10,"[2] Division, Practitioner, Team"
+2 WRITE !?10,"[3] Practitioner,Associated Clinic"
+3 WRITE !!,"Select 1 or 2 or 3: "
+4 READ X:DTIME
+5 IF (X="^")!'$TEST
QUIT 0
+6 IF (X'="1")&(X'="2")&(X'=3)
DO HLP3
GOTO EN1
+7 IF (X["?")!(X="")
DO HLP3
GOTO EN1
+8 QUIT X
HLP3 ;
+1 ;help prompt
+2 WRITE !,"Enter: ",!?5,"- 1 to sort by Division, Team, Practitioner "
+3 WRITE !?10,"- 2 to sort by Division, Practitioner, Team"
+4 QUIT
+5 ;
SORT2() ;Prompt for sorting by:
+1 ; [1] Division, Team, Patient Name
+2 ;or [2] Division, Team, SSN
+3 ;or [3] Division, Team, Practitioner, Patient Name
+4 ;or [4] Division, Team, Practitioner, SSN
+5 ;
EN4 ;
+1 NEW X
+2 WRITE !,"Sort By:",!?10,"[1] Division, Team, Patient Name"
+3 ;W !?10,"[2] Division, Team, SSN"
+4 ;IHS/ANMC/LJF 11/03/2000
WRITE !?10,"[2] Division, Team, Chart #"
+5 WRITE !?10,"[3] Division, Team, Practitioner, Patient Name"
+6 ;W !?10,"[4] Division, Team, Practitioner, SSN"
+7 ;IHS/ANMC/LJF 11/03/2000
WRITE !?10,"[4] Division, Team, Practitioner, Chart #"
+8 WRITE !!,"Select 1, 2, 3, or 4: "
+9 READ X:DTIME
+10 IF X=""!(X="^")!'$TEST
QUIT 0
+11 IF (X'="1")&(X'="2")&(X'="3")&(X'="4")
DO HLP4
GOTO EN4
+12 IF (X["?")
DO HLP4
GOTO EN4
+13 QUIT X
HLP4 ;
+1 ;help prompt
+2 WRITE !,"Enter: ",!?5,"- 1 to sort by Division, Team, Patient Name"
+3 ;IHS/ANMC/LJF 11/03/2000
WRITE !?10,"- 2 to sort by Division, Team, Chart #"
+4 ;W !?10,"- 2 to sort by Division, Team, SSN"
+5 WRITE !?10,"- 3 to sort by Division, Team, Practitioner, Patient Name"
+6 ;W !?10,"- 4 to sort by Division, Team, Practitioner, SSN"
+7 ;IHS/ANMC/LJF 11/03/2000
WRITE !?10,"- 4 to sort by Division, Team, Practitioner, Chart #"
+8 QUIT
