- DGPMRBA ;ALB/MIR - ROOM-BED AVAILABILITY; 9 JAN 89 ; 10/21/03 8:50am
- ;;5.3;Registration;**544**;Aug 13, 1993
- OPT ;called from BED AVAILABILITY OPTION
- ;
- W !!,"(A)bbreviated or (E)xpanded Bed Availability Listing? A//" R X:DTIME G:'$T!(X["^") Q I X="" S X="A" W X
- 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
- I X="A" S DGOPT=X D ABB,Q Q
- D ASK2^SDDIV G Q:Y<0 ;get OMA division(s)
- 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
- S Z="^WARD^SERVICE^BEDS" D IN^DGHELP I %<0 D G WS
- .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."
- S DGOPT=X
- I DGOPT="W"!(DGOPT="B") S VAUTNI=1 D WARD^VAUTOMA G Q:Y<0
- G:DGOPT="W" SAD G:DGOPT="B" LDG
- 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"
- S DIR("?")="Enter desired service for which you would like to see bed availability."
- S DIR("?",1)="CHOOSE FROM:"
- 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"
- 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
- I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G Q
- I Y="A" S DGSV=1 G SAD
- 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")
- F I=2:1:12 S DIR("?",I)=DIR("?",I+1)
- K DIR("?",13) S DIR("A")="Select another SERVICE: "
- ASK D ^DIR I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT G Q
- I X]"" S DGSV(Y)="" G ASK
- 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
- S DGSA='(%-1)
- 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
- S DGLD='(%-1)
- D DESC I %<0 G Q
- CONT S DGVARS="DGOPT^VAUTD#^VAUTW#^DGDESC^DGLD^DGSV#^DGSTR",DGPGM="PR^DGPMRBA1" D ZIS^DGUTQ I 'POP D PR^DGPMRBA1
- 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
- ;
- ;
- ABB ;abbreviated bed availability (single ward only)
- W ! S DIC="^DIC(42,",DIC(0)="AEQMZ" D ^DIC I Y'>0 Q
- D DESC I %<0 G Q
- D NOW^%DTC S DGDT=%
- S W=+Y,(DGA,DGFL,DGL,DGLD)=0,DGSA=1,DGNM=$P(Y(0),"^",1) D ABB^DGPMRBA1
- G ABB
- ;
- DESC ;ask to show room-bed descriptions
- W !,"Do you want to display room-bed descriptions" S %=2 D YN^DICN I %<0 Q
- I '% W !?5,"Enter 'Yes' to display the description for vacant beds, otherwise 'No'" G DESC
- S DGDESC=%#2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMRBA 3384 printed Jan 18, 2025@03:50:31 Page 2
- DGPMRBA ;ALB/MIR - ROOM-BED AVAILABILITY; 9 JAN 89 ; 10/21/03 8:50am
- +1 ;;5.3;Registration;**544**;Aug 13, 1993
- OPT ;called from BED AVAILABILITY OPTION
- +1 ;
- +2 WRITE !!,"(A)bbreviated or (E)xpanded Bed Availability Listing? A//"
- READ X:DTIME
- if '$TEST!(X["^")
- GOTO Q
- IF X=""
- SET X="A"
- WRITE X
- +3 SET Z="^ABBREVIATED^EXPANDED"
- DO IN^DGHELP
- IF %<0
- WRITE !!,"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"
- GOTO OPT
- +4 IF X="A"
- SET DGOPT=X
- DO ABB
- DO Q
- QUIT
- +5 ;get OMA division(s)
- DO ASK2^SDDIV
- if Y<0
- GOTO Q
- WS WRITE !,"Sort by (W)ARD, (S)ERVICE, or (B)EDS: W//"
- READ X:DTIME
- if '$TEST!(X["^")
- GOTO Q
- IF X=""
- SET X="W"
- WRITE X
- +1 SET Z="^WARD^SERVICE^BEDS"
- DO IN^DGHELP
- IF %<0
- Begin DoDot:1
- +2 WRITE !,"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."
- End DoDot:1
- GOTO WS
- +3 SET DGOPT=X
- +4 IF DGOPT="W"!(DGOPT="B")
- SET VAUTNI=1
- DO WARD^VAUTOMA
- if Y<0
- GOTO Q
- +5 if DGOPT="W"
- GOTO SAD
- if DGOPT="B"
- GOTO LDG
- +6 SET DIR("A")="Select SERVICE: "
- SET (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"
- SET DIR("B")="ALL"
- +7 SET DIR("?")="Enter desired service for which you would like to see bed availability."
- +8 SET DIR("?",1)="CHOOSE FROM:"
- +9 SET DIR("?",2)=" A FOR ALL"
- SET DIR("?",3)=" M FOR MEDICINE"
- SET DIR("?",4)=" S FOR SURGERY"
- SET DIR("?",5)=" P FOR PSYCHIATRY"
- SET DIR("?",6)=" NH FOR NHCU"
- SET DIR("?",7)=" NE FOR NEUROLOGY"
- +10 SET DIR("?",8)=" I FOR INTERMEDIATE MED"
- SET DIR("?",9)=" R FOR REHAB MEDICINE"
- SET DIR("?",10)=" SCI FOR SPINAL CORD INJURY"
- SET DIR("?",11)=" D FOR DOMICILLARY"
- SET DIR("?",12)=" B FOR BLIND REHAB"
- SET DIR("?",13)=" NC FOR NON-COUNT"
- DO ^DIR
- +11 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL DTOUT,DUOUT
- GOTO Q
- +12 IF Y="A"
- SET DGSV=1
- GOTO SAD
- +13 SET DGSV=0
- SET DGSV(Y)=""
- SET $PIECE(DIR(0),"^",1)=$PIECE(DIR(0),"^",1)_"O"
- SET $PIECE(DIR(0),"^",2)=$EXTRACT($PIECE(DIR(0),"^",2),7,999)
- KILL DIR("B")
- +14 FOR I=2:1:12
- SET DIR("?",I)=DIR("?",I+1)
- +15 KILL DIR("?",13)
- SET DIR("A")="Select another SERVICE: "
- ASK DO ^DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)
- KILL DUOUT,DTOUT
- GOTO Q
- +1 IF X]""
- SET DGSV(Y)=""
- GOTO ASK
- SAD WRITE !,"Do you want to display scheduled admissions"
- SET %=1
- DO YN^DICN
- if %<0
- GOTO Q
- IF '%
- WRITE !?5,"Respond 'Y'es to display scheduled admissions to the ward.",!?8,"Otherwise, respond 'N'o."
- GOTO SAD
- +1 SET DGSA='(%-1)
- LDG WRITE !,"Do you want to display lodgers"
- SET %=1
- DO YN^DICN
- if %<0
- GOTO Q
- IF '%
- WRITE !?5,"Respond 'Y'es to display lodgers to the ward.",!?8,"Otherwise, respond 'N'o."
- GOTO LDG
- +1 SET DGLD='(%-1)
- +2 DO DESC
- IF %<0
- GOTO Q
- CONT SET DGVARS="DGOPT^VAUTD#^VAUTW#^DGDESC^DGLD^DGSV#^DGSTR"
- SET DGPGM="PR^DGPMRBA1"
- DO ZIS^DGUTQ
- IF 'POP
- DO PR^DGPMRBA1
- Q KILL ^UTILITY("DGPMLD",$JOB),^TMP("DGPMBD",$JOB),%,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
- WRITE !
- DO CLOSE^DGUTQ
- QUIT
- +1 ;
- +2 ;
- ABB ;abbreviated bed availability (single ward only)
- +1 WRITE !
- SET DIC="^DIC(42,"
- SET DIC(0)="AEQMZ"
- DO ^DIC
- IF Y'>0
- QUIT
- +2 DO DESC
- IF %<0
- GOTO Q
- +3 DO NOW^%DTC
- SET DGDT=%
- +4 SET W=+Y
- SET (DGA,DGFL,DGL,DGLD)=0
- SET DGSA=1
- SET DGNM=$PIECE(Y(0),"^",1)
- DO ABB^DGPMRBA1
- +5 GOTO ABB
- +6 ;
- DESC ;ask to show room-bed descriptions
- +1 WRITE !,"Do you want to display room-bed descriptions"
- SET %=2
- DO YN^DICN
- IF %<0
- QUIT
- +2 IF '%
- WRITE !?5,"Enter 'Yes' to display the description for vacant beds, otherwise 'No'"
- GOTO DESC
- +3 SET DGDESC=%#2
- +4 QUIT