source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMRBA.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1DGPMRBA ;ALB/MIR - ROOM-BED AVAILABILITY; 9 JAN 89 ; 10/21/03 8:50am
2 ;;5.3;Registration;**544**;Aug 13, 1993
3OPT ;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)
9WS 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: "
25ASK D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT G Q
26 I X]"" S DGSV(Y)="" G ASK
27SAD 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)
29LDG 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
32CONT S DGVARS="DGOPT^VAUTD#^VAUTW#^DGDESC^DGLD^DGSV#^DGSTR",DGPGM="PR^DGPMRBA1" D ZIS^DGUTQ I 'POP D PR^DGPMRBA1
33Q 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 ;
36ABB ;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 ;
43DESC ;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
Note: See TracBrowser for help on using the repository browser.