- GMRYUT4 ;HIRMFO/YH,RM-PATIENT SELECTION BY UNIT, ROOM OR SINGLE PATIENT ;11/7/95
- ;;4.0;Intake/Output;;Apr 25, 1997
- WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE UNIT, 2. SELECTED ROOMS ON UNIT, 3. PATIENT
- W !,"By (U)nit, (S)elected unit rooms, or (P)atient? " R GMREDB:DTIME I "^"[GMREDB!('$T)!(GMREDB="") S GMROUT=1 Q
- S:GMREDB?1L GMREDB=$C($A(GMREDB)-32) S:"Uu"[GMREDB GMREDB="W" I "Ww"[GMREDB!("Ss"[GMREDB)!("Pp"[GMREDB) G WP1
- I GMREDB?1"?".E G WARDPAT
- W !,$C(7),?5,"INVALID ENTRY ??" G WARDPAT
- WP1 ;
- I "Ww"[GMREDB!("Ss"[GMREDB) D WARDSEL G:GMROUT QUIT G WARDPAT:GNORM,QUIT
- D PATDAT G QUIT
- WARDSEL ; SELECT UNIT TO BE SEARCHED
- I '$D(^NURSF(211.4)) S GMROUT=1 Q
- W ! S GNORM=0,DIC="^NURSF(211.4,",DIC(0)="AEQMZ",DIC("S")="I $S('$D(^NURSF(211.4,""D"",""I"",+Y)):1,$P(^NURSF(211.4,+Y,1),U,1)=""I"":0,1:1)"
- D ^DIC K DIC I X="^"!(+Y'>0) S GMROUT=1 Q
- W ! S GMRWARD=+Y,DFN=$O(^NURSF(214,"E",GMRWARD,0)),GMRWARD(1)=$S(GMRWARD'>0:"",'$D(^NURSF(211.4,GMRWARD,0)):"",$P(^(0),"^")="":"",$D(^SC($P(^NURSF(211.4,GMRWARD,0),"^"),0)):$P(^(0),"^"),1:"")
- S GMRWARD(1)=$S(GMRWARD(1)?1"NUR ".E:$P(GMRWARD(1),"NUR ",2),1:GMRWARD(1))
- ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON UNIT
- I DFN="" W !,$C(7),"**** NO PATIENTS REGISTERED ON WARD ",GMRWARD(1)," ****" S GMROUT=1 Q
- Q:"Ww"[GMREDB
- K GNRM F GNDA=0:0 S GNDA=$O(^NURSF(211.4,+Y,3,GNDA)) Q:GNDA'>0 S GNWLOC=$P(^NURSF(211.4,+Y,3,GNDA,0),"^") D RMST
- K GNMRC S GNURSY="" F GNURSX=1:1 S GNURSY=$O(GNRM(GNURSY)) Q:GNURSY="" S GNMRC(GNURSX)=GNURSY
- K GNRM S GNORM=$S($O(GNMRC(""))'="":0,1:1) W:GNORM !,$C(7),"NO ROOMS ON THIS UNIT",! Q:GNORM D EN3 S GNORM=$S($O(GNRMBD(""))'="":0,1:1) W:GNORM&('GMROUT) !!,$C(7),"NO ROOMS SELECTED CANNOT RUN THIS REPORT.",! K GNMRC
- Q
- RMST ;
- I $D(^DG(405.4,0)) F GND1=0:0 S GND1=$O(^DG(405.4,"W",GNWLOC,GND1)) Q:GND1'>0 S GNRM=$S($D(^DG(405.4,GND1,0)):$P($P(^(0),"^"),"-"),1:"") I GNRM'="" S GNRM(GNRM)=""
- Q
- PATDAT ; SINGLE PATIENT SELECTION
- D PATDAT^GMRYUT0
- Q
- EN3 ; SELECT ROOMS ON A GIVEN UNIT
- K I,GNRMBD S I(1)=1,I(2)=21,I(3)=41,I(4)=61,I(5)=71 W !,"Unit "_GMRWARD(1)_" has the following rooms:",! F GNURSX=0:0 S GNURSX=$O(GNMRC(GNURSX)) Q:GNURSX'<21!'(GNURSX>0) D
- .W ! W:$G(GNMRC($G(I(1))))'="" I(1),". ",?6,$G(GNMRC(I(1))) W:$G(GNMRC($G(I(2))))'="" ?16,I(2),". ",$G(GNMRC(I(2))) W:$G(GNMRC($G(I(3))))'="" ?33,I(3),". ",$G(GNMRC(I(3)))
- .W:$G(GNMRC($G(I(4))))'="" ?49,I(4),". ",$G(GNMRC(I(4))) W:$G(GNMRC($G(I(5))))'="" ?65,I(5),". ",$G(GNMRC(I(5)))
- .S I(1)=(I(1)+1),I(2)=(I(2)+1),I(3)=(I(3)+1),I(4)=(I(4)+1),I(5)=(I(5)+1)
- W !!,"Select the NUMBER(S) of the rooms: " R GNURRMST:DTIME S:'$T GNURRMST="^" I "^"[GNURRMST!(GNURRMST="") S GMROUT=1 Q
- W ! I GNURRMST?1"?".E W !,?5,"Type in number(s) associated with the rooms you want,",!,?5,"separated by commas or hyphens if there is more than one room",!,?5,"(e.g., 1-3,5 would be entries 1,2,3 and 5)." G EN3
- I '(GNURRMST?.N!(GNURRMST?.NP&(GNURRMST["-"!(GNURRMST[",")))) W $C(7)," ??" G EN3
- F GNURI=1:1 S GNURLEN=$P(GNURRMST,",",GNURI) Q:GNURLEN="" S GNURLEN(1)=$P(GNURLEN,"-",2)_"+"_GNURLEN F GNURX=+GNURLEN:1:+GNURLEN(1) S:'$D(GNMRC(GNURX)) GMROUT=1 S:$D(GNMRC(GNURX)) GNRMBD(GNMRC(GNURX))=""
- I GMROUT S GMROUT=0 G EN3
- Q
- QUIT ;
- K GNDA,GND1,GNWLOC,GNURSY,GNURSX,GNURRMST,GNURI,GNURLEN,GNORM,GNMRC,GNURX,GRMSEL,X,Y
- Q
- INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
- ; TO DETERMINE IF UNIT LOCATION (GMWLOC) IS INACTIVE.
- N X,D0,DGPMOS
- S D0=GMWLOC D WIN^DGPMDDCF
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYUT4 3499 printed Feb 18, 2025@23:22:11 Page 2
- GMRYUT4 ;HIRMFO/YH,RM-PATIENT SELECTION BY UNIT, ROOM OR SINGLE PATIENT ;11/7/95
- +1 ;;4.0;Intake/Output;;Apr 25, 1997
- WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE UNIT, 2. SELECTED ROOMS ON UNIT, 3. PATIENT
- +1 WRITE !,"By (U)nit, (S)elected unit rooms, or (P)atient? "
- READ GMREDB:DTIME
- IF "^"[GMREDB!('$TEST)!(GMREDB="")
- SET GMROUT=1
- QUIT
- +2 if GMREDB?1L
- SET GMREDB=$CHAR($ASCII(GMREDB)-32)
- if "Uu"[GMREDB
- SET GMREDB="W"
- IF "Ww"[GMREDB!("Ss"[GMREDB)!("Pp"[GMREDB)
- GOTO WP1
- +3 IF GMREDB?1"?".E
- GOTO WARDPAT
- +4 WRITE !,$CHAR(7),?5,"INVALID ENTRY ??"
- GOTO WARDPAT
- WP1 ;
- +1 IF "Ww"[GMREDB!("Ss"[GMREDB)
- DO WARDSEL
- if GMROUT
- GOTO QUIT
- if GNORM
- GOTO WARDPAT
- GOTO QUIT
- +2 DO PATDAT
- GOTO QUIT
- WARDSEL ; SELECT UNIT TO BE SEARCHED
- +1 IF '$DATA(^NURSF(211.4))
- SET GMROUT=1
- QUIT
- +2 WRITE !
- SET GNORM=0
- SET DIC="^NURSF(211.4,"
- SET DIC(0)="AEQMZ"
- SET DIC("S")="I $S('$D(^NURSF(211.4,""D"",""I"",+Y)):1,$P(^NURSF(211.4,+Y,1),U,1)=""I"":0,1:1)"
- +3 DO ^DIC
- KILL DIC
- IF X="^"!(+Y'>0)
- SET GMROUT=1
- QUIT
- +4 WRITE !
- SET GMRWARD=+Y
- SET DFN=$ORDER(^NURSF(214,"E",GMRWARD,0))
- SET GMRWARD(1)=$SELECT(GMRWARD'>0:"",'$DATA(^NURSF(211.4,GMRWARD,0)):"",$PIECE(^(0),"^")="":"",$DATA(^SC($PIECE(^NURSF(211.4,GMRWARD,0),"^"),0)):$PIECE(^(0),"^"),1:"")
- +5 SET GMRWARD(1)=$SELECT(GMRWARD(1)?1"NUR ".E:$PIECE(GMRWARD(1),"NUR ",2),1:GMRWARD(1))
- +6 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON UNIT
- +7 IF DFN=""
- WRITE !,$CHAR(7),"**** NO PATIENTS REGISTERED ON WARD ",GMRWARD(1)," ****"
- SET GMROUT=1
- QUIT
- +8 if "Ww"[GMREDB
- QUIT
- +9 KILL GNRM
- FOR GNDA=0:0
- SET GNDA=$ORDER(^NURSF(211.4,+Y,3,GNDA))
- if GNDA'>0
- QUIT
- SET GNWLOC=$PIECE(^NURSF(211.4,+Y,3,GNDA,0),"^")
- DO RMST
- +10 KILL GNMRC
- SET GNURSY=""
- FOR GNURSX=1:1
- SET GNURSY=$ORDER(GNRM(GNURSY))
- if GNURSY=""
- QUIT
- SET GNMRC(GNURSX)=GNURSY
- +11 KILL GNRM
- SET GNORM=$SELECT($ORDER(GNMRC(""))'="":0,1:1)
- if GNORM
- WRITE !,$CHAR(7),"NO ROOMS ON THIS UNIT",!
- if GNORM
- QUIT
- DO EN3
- SET GNORM=$SELECT($ORDER(GNRMBD(""))'="":0,1:1)
- if GNORM&('GMROUT)
- WRITE !!,$CHAR(7),"NO ROOMS SELECTED CANNOT RUN THIS REPORT.",!
- KILL GNMRC
- +12 QUIT
- RMST ;
- +1 IF $DATA(^DG(405.4,0))
- FOR GND1=0:0
- SET GND1=$ORDER(^DG(405.4,"W",GNWLOC,GND1))
- if GND1'>0
- QUIT
- SET GNRM=$SELECT($DATA(^DG(405.4,GND1,0)):$PIECE($PIECE(^(0),"^"),"-"),1:"")
- IF GNRM'=""
- SET GNRM(GNRM)=""
- +2 QUIT
- PATDAT ; SINGLE PATIENT SELECTION
- +1 DO PATDAT^GMRYUT0
- +2 QUIT
- EN3 ; SELECT ROOMS ON A GIVEN UNIT
- +1 KILL I,GNRMBD
- SET I(1)=1
- SET I(2)=21
- SET I(3)=41
- SET I(4)=61
- SET I(5)=71
- WRITE !,"Unit "_GMRWARD(1)_" has the following rooms:",!
- FOR GNURSX=0:0
- SET GNURSX=$ORDER(GNMRC(GNURSX))
- if GNURSX'<21!'(GNURSX>0)
- QUIT
- Begin DoDot:1
- +2 WRITE !
- if $GET(GNMRC($GET(I(1))))'=""
- WRITE I(1),". ",?6,$GET(GNMRC(I(1)))
- if $GET(GNMRC($GET(I(2))))'=""
- WRITE ?16,I(2),". ",$GET(GNMRC(I(2)))
- if $GET(GNMRC($GET(I(3))))'=""
- WRITE ?33,I(3),". ",$GET(GNMRC(I(3)))
- +3 if $GET(GNMRC($GET(I(4))))'=""
- WRITE ?49,I(4),". ",$GET(GNMRC(I(4)))
- if $GET(GNMRC($GET(I(5))))'=""
- WRITE ?65,I(5),". ",$GET(GNMRC(I(5)))
- +4 SET I(1)=(I(1)+1)
- SET I(2)=(I(2)+1)
- SET I(3)=(I(3)+1)
- SET I(4)=(I(4)+1)
- SET I(5)=(I(5)+1)
- End DoDot:1
- +5 WRITE !!,"Select the NUMBER(S) of the rooms: "
- READ GNURRMST:DTIME
- if '$TEST
- SET GNURRMST="^"
- IF "^"[GNURRMST!(GNURRMST="")
- SET GMROUT=1
- QUIT
- +6 WRITE !
- IF GNURRMST?1"?".E
- WRITE !,?5,"Type in number(s) associated with the rooms you want,",!,?5,"separated by commas or hyphens if there is more than one room",!,?5,"(e.g., 1-3,5 would be entries 1,2,3 and 5)."
- GOTO EN3
- +7 IF '(GNURRMST?.N!(GNURRMST?.NP&(GNURRMST["-"!(GNURRMST[","))))
- WRITE $CHAR(7)," ??"
- GOTO EN3
- +8 FOR GNURI=1:1
- SET GNURLEN=$PIECE(GNURRMST,",",GNURI)
- if GNURLEN=""
- QUIT
- SET GNURLEN(1)=$PIECE(GNURLEN,"-",2)_"+"_GNURLEN
- FOR GNURX=+GNURLEN:1:+GNURLEN(1)
- if '$DATA(GNMRC(GNURX))
- SET GMROUT=1
- if $DATA(GNMRC(GNURX))
- SET GNRMBD(GNMRC(GNURX))=""
- +9 IF GMROUT
- SET GMROUT=0
- GOTO EN3
- +10 QUIT
- QUIT ;
- +1 KILL GNDA,GND1,GNWLOC,GNURSY,GNURSX,GNURRMST,GNURI,GNURLEN,GNORM,GNMRC,GNURX,GRMSEL,X,Y
- +2 QUIT
- INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
- +1 ; TO DETERMINE IF UNIT LOCATION (GMWLOC) IS INACTIVE.
- +2 NEW X,D0,DGPMOS
- +3 SET D0=GMWLOC
- DO WIN^DGPMDDCF
- +4 QUIT X