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 Dec 13, 2024@01:55:49 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
