| 1 | IBODIV ;BSN/GRR - MULTI-DIVISION SELECT ; 27 FEB 84 9:40 am
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**124**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | ; -- copied for scheduling v5.3 routine SDDIV
|
|---|
| 5 | ;
|
|---|
| 6 | ROUT S DIC("A")="ROUTING SLIPS FOR WHICH DIVISION: " G ASK
|
|---|
| 7 | APLST S DIC("A")="APPOINTMENT LIST FOR WHICH DIVISION: " G ASK
|
|---|
| 8 | FRLST S DIC("A")="FILE ROOM LIST FOR WHICH DIVISION: " G ASK
|
|---|
| 9 | CLST S DIC("A")="CLINIC LIST FOR WHICH DIVISION: " G ASK
|
|---|
| 10 | PALST S DIC("A")="PRE-APPOINTMENT LETTERS FOR WHICH DIVISION: " G DIC
|
|---|
| 11 | CNLET S DIC("A")="CANCELLATION LETTERS FOR WHICH DIVISION: " G DIC
|
|---|
| 12 | PCNLET S DIC("A")="APPOINTMENT CANCELLATION LETTERS FOR WHICH DIVISION: " G DIC
|
|---|
| 13 | NSLET S DIC("A")="NO-SHOW LETTERS/AUTO REBOOK REPORT FOR WHICH DIVISION: " G ASK
|
|---|
| 14 | NSLET1 S DIC("A")="NO-SHOW LETTERS FOR WHICH DIVISION: " G DIC
|
|---|
| 15 | RALST S DIC("A")="RADIOLOGY LIST FOR WHICH DIVISION: " G ASK
|
|---|
| 16 | A223 S DIC("A")="AMIS SEGMENT 223 FOR WHICH DIVISION: " G ASK
|
|---|
| 17 | CSSD S DIC("A")="CREATE SURVEY DISPOSITIONING RECORDS FOR WHICH DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): " G ASK
|
|---|
| 18 | SDCP S DIC("A")="CLINIC PROFILES FOR WHICH DIVISION: " G ASK
|
|---|
| 19 | DSSA S DIC("A")="DISPOSITION SURVEY APPOINTMENTS FOR WHICH DIVISION: " G ASK
|
|---|
| 20 | PSDR S DIC("A")="DIVISION (ENTER 'ALL' FOR ALL DIVISIONS): " G ASK2
|
|---|
| 21 | CSEE S DIC("A")="ENTER VISIT DATA FOR WHICH DIVISION: " G ASK
|
|---|
| 22 | CALST S DIC("A")="CLINIC ASSIGNMENT LIST FOR WHICH DIVISION: " G ASK
|
|---|
| 23 | CACTLST S DIC("A")="CLINIC WORKLOAD LIST FOR WHICH DIVISION: " G ASK
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | 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
|
|---|
| 27 | I X="ALL" S ALL=1 I $D(SDALL),'SDALL S X="?",ALL=0 W *7," ??"
|
|---|
| 28 | 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"
|
|---|
| 29 | 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
|
|---|
| 30 | AWAY S Y=1 K DIC,SDEF Q
|
|---|
| 31 | ERR S Y=-1 K DIC,SDALL,SDEF Q
|
|---|
| 32 | 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
|
|---|
| 33 | I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) G DIVISION^VAUTOMA
|
|---|
| 34 | S I=$O(^DG(40.8,0)) G:'$D(^DG(40.8,I,0)) ERR S VAUTD(I)=$P(^(0),U) K DIC Q
|
|---|
