Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPU2

SCRPU2.m

Go to the documentation of this file. 
  1. 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
  1.  ;IHS/ANMC/LJF 11/03/2000 changed Last 4 of PID to Chart #
  1.  ;
  1. DTRANG(FIRST,SECOND) ;Date Range - begin date ^ end date => fileman format
  1.  ;FIRST - first prompt (not required)
  1.  ;SECOND - second prompt (not required)
  1.  N BDATE,EDATE,DIROUT,DUOUT,DTOUT
  1.  S EDATE=-1
  1.  S DIR(0)="D^::E",DIR("B")="Today"
  1.  I '$D(FIRST) S DIR("A")="Begin Date"
  1.  I $D(FIRST) S DIR("A")=FIRST
  1.  D ^DIR
  1.  I $D(DTOUT)!(X="Today") S BDATE=$P(DT,".")
  1.  I $D(DUOUT)!($D(DIROUT))  Q -1
  1.  S BDATE=+Y
  1. DEN I '$D(SECOND) S DIR("A")="End Date"
  1.  I $D(SECOND) S DIR("A")=SECOND
  1.  K DTOUT,X,Y
  1.  D ^DIR
  1.  I $D(DTOUT)!(X="Today") S EDATE=$P(DT,".")
  1.  I $D(DUOUT)!($D(DIROUT)) Q -1
  1.  S EDATE=+Y
  1.  I EDATE<BDATE W !,"End date can't occur before Begin Date",! G DEN
  1.  K X,Y,DIR
  1.  Q BDATE_"^"_EDATE
  1.  ;
  1. GTEAM(CLN,DFN) ;
  1.  ;given clinic and patient, find related team
  1.  N TPEN,FOUND,TEAM
  1.  S TPEN="",FOUND=0
  1.  F  S TPEN=$O(^SCTM(404.57,"E",CLN,TPEN)) Q:TPEN=""!(FOUND)  D
  1.  .S TEAM=$P(^SCTM(404.57,TPEN,0),"^",2)
  1.  .I $D(^SCPT(404.42,"APTTM",DFN,TEAM)) S FOUND=1
  1.  I FOUND=1 Q TEAM
  1.  Q FOUND
  1.  ;
  1. ASSUN ;
  1.  ;prompt for assigned or unassigned to Primary Care Team
  1.  N VAUTVB
  1.  S VAUTVB="VAUTA"
  1.  W !,"(A)ssigned or (U)nassigned Patients to Primary Care Team: "
  1.  R X:DTIME
  1.  I (X="^")!'$T G ERR
  1.  I (X'="A")&(X'="U") D HLP G ASSUN
  1.  I (X="")!(X["?") D HLP G ASSUN
  1.  I X="A" S @VAUTVB=1
  1.  I X="U" S @VAUTVB=0
  1.  K X
  1.  Q
  1.  ;
  1. PCLNHR() ;Prompt to Print Clinic Hours
  1.  S DIR("A")="Print Clinic Hours",DIR("B")="Y"
  1.  Q $$YESNO()
  1.  ;
  1. PCLNIN() ;Prompt to Print Clinic Information
  1.  S DIR("A")="Print Clinic Information",DIR("B")="Y"
  1.  Q $$YESNO()
  1.  ;
  1. SUMM() ;Prompt to Print Summary Only (y/n)
  1.  S DIR("A")="Print Summary Only",DIR("B")="N"
  1.  S DIR("?")="Enter 'Y' to have patient names excluded, 'N' to include patient names"
  1.  Q $$YESNO()
  1.  ;
  1. YESNO() ;Yes/No prompt
  1.  N X,DTOUT,DUOUT,DIROUT,Y
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  I $D(DTOUT)!(X="") S Y=$S(DIR("B")="Y":1,1:0)
  1.  I $D(DUOUT)!($D(DIROUT)) S Y=-1
  1.  K DIR
  1.  Q +Y
  1.  ;
  1. PTSTAT ;Prompt for Patient Status (All, OPT, AC)
  1.  ;Modified by patch 172
  1.  S VAUTPS=1 Q
  1.  ;
  1.  N X,STAT,VAUTVB
  1.  S VAUTVB="VAUTPS"
  1.  W !,"Patient Status: ALL//"
  1.  R X:DTIME
  1.  I '$T!(X="")!(X="ALL") S @VAUTVB=1
  1.  I X="^" G ERR
  1.  I (X["?") D HLP2 G PTSTAT
  1.  I X="A"!(X="AC") S @VAUTVB="AC"
  1.  I X="O"!(X="OPT") S @VAUTVB="OPT"
  1.  I '$D(@VAUTVB) D HLP2 G PTSTAT
  1.  Q
  1.  ;
  1. HLP2 ;help prompt for Patient Status
  1.  W !,"Enter: ",!?10,"- A or AC for patients whose status is AC"
  1.  W !?10,"- O or OPT for patient whose status is OPT"
  1.  W !?10,"- Enter or ALL for both AC and OPT patients"
  1.  Q
  1. HLP ;
  1.  ;help prompt
  1.  W !,"Enter: ",!?5,"- A for patients assigned to the team as Primary Care"
  1.  W !?10,"- U for patients not assigned to the team as Primary Care"
  1.  Q
  1.  ;
  1. ERR S Y=-1 I $O(@VAUTVB@(0))="" K @VAUTVB
  1. QUIT S:'$D(Y) Y=1 K DIC,J,VAERR,VAI,VAJ,VAJ1,VAX,VAUTNI,VAUTSTR,VAUTVB,X
  1.  Q
  1.  ;
  1. SORT() ;
  1.  ;Prompt for sorting by Division, Team, Practitioner or Division, Practitioner, Team
  1.  ;
  1. EN1 N X
  1.  W !,"Sort By:",!?10,"[1] Division, Team, Practitioner",!?10,"[2] Division, Practitioner, Team"
  1.  W !?10,"[3] Practitioner,Associated Clinic"
  1.  W !!,"Select 1 or 2 or 3: "
  1.  R X:DTIME
  1.  I (X="^")!'$T Q 0
  1.  I (X'="1")&(X'="2")&(X'=3) D HLP3 G EN1
  1.  I (X["?")!(X="") D HLP3 G EN1
  1.  Q X
  1. HLP3 ;
  1.  ;help prompt
  1.  W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Practitioner "
  1.  W !?10,"- 2 to sort by Division, Practitioner, Team"
  1.  Q
  1.  ;
  1. SORT2() ;Prompt for sorting by:
  1.  ;   [1] Division, Team, Patient Name
  1.  ;or [2] Division, Team, SSN
  1.  ;or [3] Division, Team, Practitioner, Patient Name
  1.  ;or [4] Division, Team, Practitioner, SSN
  1.  ;
  1. EN4 ;
  1.  N X
  1.  W !,"Sort By:",!?10,"[1] Division, Team, Patient Name"
  1.  ;W !?10,"[2] Division, Team, SSN"
  1.  W !?10,"[2] Division, Team, Chart #"         ;IHS/ANMC/LJF 11/03/2000
  1.  W !?10,"[3] Division, Team, Practitioner, Patient Name"
  1.  ;W !?10,"[4] Division, Team, Practitioner, SSN"
  1.  W !?10,"[4] Division, Team, Practitioner, Chart #"  ;IHS/ANMC/LJF 11/03/2000
  1.  W !!,"Select 1, 2, 3, or 4: "
  1.  R X:DTIME
  1.  I X=""!(X="^")!'$T Q 0
  1.  I (X'="1")&(X'="2")&(X'="3")&(X'="4") D HLP4 G EN4
  1.  I (X["?") D HLP4 G EN4
  1.  Q X
  1. HLP4 ;
  1.  ;help prompt
  1.  W !,"Enter: ",!?5,"- 1 to sort by Division, Team, Patient Name"
  1.  W !?10,"- 2 to sort by Division, Team, Chart #"   ;IHS/ANMC/LJF 11/03/2000
  1.  ;W !?10,"- 2 to sort by Division, Team, SSN"
  1.  W !?10,"- 3 to sort by Division, Team, Practitioner, Patient Name"
  1.  ;W !?10,"- 4 to sort by Division, Team, Practitioner, SSN"
  1.  W !?10,"- 4 to sort by Division, Team, Practitioner, Chart #"  ;IHS/ANMC/LJF 11/03/2000
  1.  Q