- IBODIV ;BSN/GRR - MULTI-DIVISION SELECT ; 27 FEB 84 9:40 am
- ;;2.0;INTEGRATED BILLING;**124**;21-MAR-94
- ;
- ; -- copied for scheduling v5.3 routine SDDIV
- ;
- 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,$O(^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=$O(^DG(40.8,0)) G:'$D(^DG(40.8,I,0)) ERR S VAUTD(I)=$P(^(0),U) K DIC Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBODIV 2183 printed Jan 18, 2025@03:26:38 Page 2
- IBODIV ;BSN/GRR - MULTI-DIVISION SELECT ; 27 FEB 84 9:40 am
- +1 ;;2.0;INTEGRATED BILLING;**124**;21-MAR-94
- +2 ;
- +3 ; -- copied for scheduling v5.3 routine SDDIV
- +4 ;
- 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
- IF '$DATA(^DG(40.8,$ORDER(^DG(40.8,0)),0))
- WRITE !,*7,"***WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP"
- GOTO ERR
- +1 IF $DATA(^DG(43,1,"GL"))
- IF $PIECE(^("GL"),U,2)
- GOTO DIVISION^VAUTOMA
- +2 SET I=$ORDER(^DG(40.8,0))
- if '$DATA(^DG(40.8,I,0))
- GOTO ERR
- SET VAUTD(I)=$PIECE(^(0),U)
- KILL DIC
- QUIT