SDDIV ;BSN/GRR - MULTI-DIVISION SELECT ; 27 FEB 84 9:40 am
;;5.3;Scheduling;**20**;Aug 13, 1993
ROUT S DIC("A")="ROUTING SLIPS FOR WHICH DIVISION: " G ASK
APLST S DIC("A")="APPOINTMENT LIST FOR WHICH DIVISION: " G ASK
FRLST S DIC("A")="FILE ROOM LIST FOR WHICH DIVISION: " G ASK
CLST S DIC("A")="CLINIC LIST FOR WHICH DIVISION: " G ASK
PALST S DIC("A")="PRE-APPOINTMENT LETTERS FOR WHICH DIVISION: " G DIC
CNLET S DIC("A")="CANCELLATION LETTERS FOR WHICH DIVISION: " G DIC
PCNLET S DIC("A")="APPOINTMENT CANCELLATION LETTERS FOR WHICH DIVISION: " G DIC
NSLET S DIC("A")="NO-SHOW LETTERS/AUTO REBOOK REPORT FOR WHICH DIVISION: " G ASK
NSLET1 S DIC("A")="NO-SHOW LETTERS FOR WHICH DIVISION: " G DIC
RALST S DIC("A")="RADIOLOGY LIST FOR WHICH DIVISION: " G ASK
A223 S DIC("A")="AMIS SEGMENT 223 FOR WHICH DIVISION: " G ASK
CSSD S DIC("A")="CREATE SURVEY DISPOSITIONING RECORDS FOR WHICH DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): " G ASK
SDCP S DIC("A")="CLINIC PROFILES FOR WHICH DIVISION: " G ASK
DSSA S DIC("A")="DISPOSITION SURVEY APPOINTMENTS FOR WHICH DIVISION: " G ASK
PSDR S DIC("A")="DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): " G ASK2
CSEE S DIC("A")="ENTER VISIT DATA FOR WHICH DIVISION: " G ASK
CALST S DIC("A")="CLINIC ASSIGNMENT LIST FOR WHICH DIVISION: " G ASK
CACTLST S DIC("A")="CLINIC WORKLOAD LIST FOR WHICH DIVISION: " G ASK
Q
;
ASK S ALL=0,SDEF=$$PRIM^VASITE G:'$D(^DG(40.8,SDEF,0)) ERR W !,DIC("A")," ",$P(^(0),"^"),"// " R X:DTIME I X["^" G ERR
I X="ALL" S ALL=1 I $D(SDALL),'SDALL S X="?",ALL=0 W *7," ??"
S:X="" DIV=SDEF G:X=""!(X="ALL") AWAY S DIC="^DG(40.8,",DIC(0)="EQMN" I X["?",$S('$D(SDALL):1,SDALL:1,1:0) W " Enter 'ALL' for all divisions or"
DIC D ^DIC G:X["?"!((Y<0)&('$D(SDLT))) ASK Q:$D(SDLT)&(Y'>0) S:$D(SDLT) SDV1=+Y S DIV=+Y K DIC Q
AWAY S Y=1 K DIC,SDEF Q
ERR S Y=-1 K DIC,SDALL,SDEF Q
ASK2 S (VAUTD,Y)=0 I '$D(^DG(40.8,$N(^DG(40.8,0)),0)) W !,*7,"***WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP" G ERR
I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) G DIVISION^VAUTOMA
S I=$N(^DG(40.8,0)) G:'$D(^DG(40.8,I,0)) ERR S VAUTD(I)=$P(^(0),U) K DIC Q
; *** Notify IB if any significant changes occur in this routine. ***
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDDIV 2192 printed Oct 16, 2024@18:50:19 Page 2
SDDIV ;BSN/GRR - MULTI-DIVISION SELECT ; 27 FEB 84 9:40 am
+1 ;;5.3;Scheduling;**20**;Aug 13, 1993
ROUT SET DIC("A")="ROUTING SLIPS FOR WHICH DIVISION: "
GOTO ASK
APLST SET DIC("A")="APPOINTMENT LIST FOR WHICH DIVISION: "
GOTO ASK
FRLST SET DIC("A")="FILE ROOM LIST FOR WHICH DIVISION: "
GOTO ASK
CLST SET DIC("A")="CLINIC LIST FOR WHICH DIVISION: "
GOTO ASK
PALST SET DIC("A")="PRE-APPOINTMENT LETTERS FOR WHICH DIVISION: "
GOTO DIC
CNLET SET DIC("A")="CANCELLATION LETTERS FOR WHICH DIVISION: "
GOTO DIC
PCNLET SET DIC("A")="APPOINTMENT CANCELLATION LETTERS FOR WHICH DIVISION: "
GOTO DIC
NSLET SET DIC("A")="NO-SHOW LETTERS/AUTO REBOOK REPORT FOR WHICH DIVISION: "
GOTO ASK
NSLET1 SET DIC("A")="NO-SHOW LETTERS FOR WHICH DIVISION: "
GOTO DIC
RALST SET DIC("A")="RADIOLOGY LIST FOR WHICH DIVISION: "
GOTO ASK
A223 SET DIC("A")="AMIS SEGMENT 223 FOR WHICH DIVISION: "
GOTO ASK
CSSD SET DIC("A")="CREATE SURVEY DISPOSITIONING RECORDS FOR WHICH DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): "
GOTO ASK
SDCP SET DIC("A")="CLINIC PROFILES FOR WHICH DIVISION: "
GOTO ASK
DSSA SET DIC("A")="DISPOSITION SURVEY APPOINTMENTS FOR WHICH DIVISION: "
GOTO ASK
PSDR SET DIC("A")="DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): "
GOTO ASK2
CSEE SET DIC("A")="ENTER VISIT DATA FOR WHICH DIVISION: "
GOTO ASK
CALST SET DIC("A")="CLINIC ASSIGNMENT LIST FOR WHICH DIVISION: "
GOTO ASK
CACTLST SET DIC("A")="CLINIC WORKLOAD LIST FOR WHICH DIVISION: "
GOTO ASK
+1 QUIT
+2 ;
ASK SET ALL=0
SET SDEF=$$PRIM^VASITE
if '$DATA(^DG(40.8,SDEF,0))
GOTO ERR
WRITE !,DIC("A")," ",$PIECE(^(0),"^"),"// "
READ X:DTIME
IF X["^"
GOTO ERR
+1 IF X="ALL"
SET ALL=1
IF $DATA(SDALL)
IF 'SDALL
SET X="?"
SET ALL=0
WRITE *7," ??"
+2 if X=""
SET DIV=SDEF
if X=""!(X="ALL")
GOTO AWAY
SET DIC="^DG(40.8,"
SET DIC(0)="EQMN"
IF X["?"
IF $SELECT('$DATA(SDALL):1,SDALL:1,1:0)
WRITE " Enter 'ALL' for all divisions or"
DIC DO ^DIC
if X["?"!((Y<0)&('$DATA(SDLT)))
GOTO ASK
if $DATA(SDLT)&(Y'>0)
QUIT
if $DATA(SDLT)
SET SDV1=+Y
SET DIV=+Y
KILL DIC
QUIT
AWAY SET Y=1
KILL DIC,SDEF
QUIT
ERR SET Y=-1
KILL DIC,SDALL,SDEF
QUIT
ASK2 SET (VAUTD,Y)=0
