| 1 | DGPMRBA ;ALB/MIR - ROOM-BED AVAILABILITY; 9 JAN 89 ; 10/21/03 8:50am
|
|---|
| 2 | ;;5.3;Registration;**544**;Aug 13, 1993
|
|---|
| 3 | OPT ;called from BED AVAILABILITY OPTION
|
|---|
| 4 | ;
|
|---|
| 5 | W !!,"(A)bbreviated or (E)xpanded Bed Availability Listing? A//" R X:DTIME G:'$T!(X["^") Q I X="" S X="A" W X
|
|---|
| 6 | S Z="^ABBREVIATED^EXPANDED" D IN^DGHELP I %<0 W !!,"ENTER:",!?5,"'A' to see bed availability for a single ward, or",!?5,"'E' for bed availability for multiple wards, by service or",!?9,"a list of all available beds" G OPT
|
|---|
| 7 | I X="A" S DGOPT=X D ABB,Q Q
|
|---|
| 8 | D ASK2^SDDIV G Q:Y<0 ;get OMA division(s)
|
|---|
| 9 | WS W !,"Sort by (W)ARD, (S)ERVICE, or (B)EDS: W//" R X:DTIME G Q:'$T!(X["^") I X="" S X="W" W X
|
|---|
| 10 | S Z="^WARD^SERVICE^BEDS" D IN^DGHELP I %<0 D G WS
|
|---|
| 11 | .W !,"ENTER:",!?5,"'W' to see available beds for one, many, or all wards, or",!?5,"'S' to see available beds for one, many, or all services, or",!?5,"'B' to see all available beds and wards which can assign them."
|
|---|
| 12 | S DGOPT=X
|
|---|
| 13 | I DGOPT="W"!(DGOPT="B") S VAUTNI=1 D WARD^VAUTOMA G Q:Y<0
|
|---|
| 14 | G:DGOPT="W" SAD G:DGOPT="B" LDG
|
|---|
| 15 | S DIR("A")="Select SERVICE: ",(DIR(0),DGSTR)="SA^A:ALL;M:MEDICINE;S:SURGERY;P:PSYCHIATRY;NH:NHCU;NE:NEUROLOGY;I:INTERMEDIATE MED;R:REHAB MEDICINE;SCI:SPINAL CORD INJURY;D:DOMICILLARY;B:BLIND REHAB;NC:NON-COUNT",DIR("B")="ALL"
|
|---|
| 16 | S DIR("?")="Enter desired service for which you would like to see bed availability."
|
|---|
| 17 | S DIR("?",1)="CHOOSE FROM:"
|
|---|
| 18 | S DIR("?",2)=" A FOR ALL",DIR("?",3)=" M FOR MEDICINE",DIR("?",4)=" S FOR SURGERY",DIR("?",5)=" P FOR PSYCHIATRY",DIR("?",6)=" NH FOR NHCU",DIR("?",7)=" NE FOR NEUROLOGY"
|
|---|
| 19 | S DIR("?",8)=" I FOR INTERMEDIATE MED",DIR("?",9)=" R FOR REHAB MEDICINE",DIR("?",10)=" SCI FOR SPINAL CORD INJURY",DIR("?",11)=" D FOR DOMICILLARY",DIR("?",12)=" B FOR BLIND REHAB",DIR("?",13)=" NC FOR NON-COUNT" D ^DIR
|
|---|
| 20 | I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G Q
|
|---|
| 21 | I Y="A" S DGSV=1 G SAD
|
|---|
| 22 | S DGSV=0,DGSV(Y)="",$P(DIR(0),"^",1)=$P(DIR(0),"^",1)_"O",$P(DIR(0),"^",2)=$E($P(DIR(0),"^",2),7,999) K DIR("B")
|
|---|
| 23 | F I=2:1:12 S DIR("?",I)=DIR("?",I+1)
|
|---|
| 24 | K DIR("?",13) S DIR("A")="Select another SERVICE: "
|
|---|
| 25 | ASK D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT G Q
|
|---|
| 26 | I X]"" S DGSV(Y)="" G ASK
|
|---|
| 27 | SAD W !,"Do you want to display scheduled admissions" S %=1 D YN^DICN G Q:%<0 I '% W !?5,"Respond 'Y'es to display scheduled admissions to the ward.",!?8,"Otherwise, respond 'N'o." G SAD
|
|---|
| 28 | S DGSA='(%-1)
|
|---|
| 29 | LDG W !,"Do you want to display lodgers" S %=1 D YN^DICN G Q:%<0 I '% W !?5,"Respond 'Y'es to display lodgers to the ward.",!?8,"Otherwise, respond 'N'o." G LDG
|
|---|
| 30 | S DGLD='(%-1)
|
|---|
| 31 | D DESC I %<0 G Q
|
|---|
| 32 | CONT S DGVARS="DGOPT^VAUTD#^VAUTW#^DGDESC^DGLD^DGSV#^DGSTR",DGPGM="PR^DGPMRBA1" D ZIS^DGUTQ I 'POP D PR^DGPMRBA1
|
|---|
| 33 | Q K ^UTILITY("DGPMLD",$J),^TMP("DGPMBD",$J),%,DFN,DGA,DGDESC,DGDT,DGFL,DGHOW,DGI,DGJ,DGL,DGLD,DGND,DGNM,DGNOW,DGONE,DGPG,DGPGM,DGOPT,DGR,DGSA,DGSTR,DGSV,DGU,DGVARS,DIC,DIR,I,I1,J,J1,M,POP,W,X,Y,VA,VAUTD,VAUTW,Y,Z W ! D CLOSE^DGUTQ Q
|
|---|
| 34 | ;
|
|---|
| 35 | ;
|
|---|
| 36 | ABB ;abbreviated bed availability (single ward only)
|
|---|
| 37 | W ! S DIC="^DIC(42,",DIC(0)="AEQMZ" D ^DIC I Y'>0 Q
|
|---|
| 38 | D DESC I %<0 G Q
|
|---|
| 39 | D NOW^%DTC S DGDT=%
|
|---|
| 40 | S W=+Y,(DGA,DGFL,DGL,DGLD)=0,DGSA=1,DGNM=$P(Y(0),"^",1) D ABB^DGPMRBA1
|
|---|
| 41 | G ABB
|
|---|
| 42 | ;
|
|---|
| 43 | DESC ;ask to show room-bed descriptions
|
|---|
| 44 | W !,"Do you want to display room-bed descriptions" S %=2 D YN^DICN I %<0 Q
|
|---|
| 45 | I '% W !?5,"Enter 'Yes' to display the description for vacant beds, otherwise 'No'" G DESC
|
|---|
| 46 | S DGDESC=%#2
|
|---|
| 47 | Q
|
|---|
