NURCUT0 ;HIRMFO/MD,RM,FT-PATIENT SELECTION UTILITY BY WARD, ROOM OR SINGLE PATIENT ;7/24/97
;;4.0;NURSING SERVICE;**2,7,21**;Apr 25, 1997
WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE WARD, 2. SELECTED ROOMS ON WARD, 3. PATIENT
S (NUROUT,NURQUIT)=0 W !,"By (U)nit, (S)elected unit rooms, or (P)atient? " R NUREDB:DTIME I "^"[NUREDB!('$T) S (NUROUT,NURQUIT)=1 Q
S:NUREDB?1L NUREDB=$C($A(NUREDB)-32) I "Uu"[NUREDB!("Ss"[NUREDB)!("Pp"[NUREDB) G WP1
I NUREDB?1"?".E G WARDPAT
W !,$C(7),?5,"INVALID ENTRY ??" G WARDPAT
WP1 ;
I "Uu"[NUREDB!("Ss"[NUREDB) D WARDSEL Q:NURQUIT G WARDPAT:$G(NORM),QUIT
D PATDAT I +Y'>0 W ! G WARDPAT
G QUIT
WARDSEL ; SELECT WARD TO BE SEARCHED
W ! S NORM=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)"
S DIC("A")="Select Unit: "
D ^DIC K DIC I X="^"!(+Y'>0) S:$D(NURLOCSW) NURQUIT=1 Q:NURQUIT=1 W ! G WARDPAT
W ! S (NURWARD,NPWARD)=+Y,DFN=$O(^NURSF(214,"E",NURWARD,0)) D EN6^NURSAUTL
; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
I DFN="" W !,$C(7),"**** NO PATIENTS REGISTERED ON UNIT ",NPWARD," ****" S NURQUIT=1 Q
Q:"Uu"[NUREDB
K NRM F NDA=0:0 S NDA=$O(^NURSF(211.4,+Y,3,NDA)) Q:NDA'>0 S NWLOC=$P(^NURSF(211.4,+Y,3,NDA,0),"^") D RMST
K NMRC S NURSY="" F NURSX=1:1 S NURSY=$O(NRM(NURSY)) Q:NURSY="" S NMRC(NURSX)=NURSY
K NRM S NORM=$S($O(NMRC(""))'="":0,1:1) W:NORM !,$C(7),"NO ROOMS ON THIS UNIT",! Q:NORM D EN3 S NORM=$S($O(NRMBD(""))'="":0,1:1) W:NORM&('NURQUIT) !!,$C(7),"NO ROOMS SELECTED CANNOT RUN THIS REPORT.",! K NMRC
Q
RMST ;
I $D(^DG(405.4,0)) F ND1=0:0 S ND1=$O(^DG(405.4,"W",NWLOC,ND1)) Q:ND1'>0 S NRM=$S($D(^DG(405.4,ND1,0)):$P($P(^(0),"^"),"-",1,2),1:"") I NRM'="" S NRM(NRM)=""
Q
PATDAT ; SINGLE PATIENT SELECTION
S:'$D(NACT) NACT=1
S DIC(0)="EQMZ",NASK=1 D EN7^NURSCUTL I DFN'>0 S NURQUIT=1 Q
S DFN=+Y
Q
EN3 ; SELECT ROOMS ON A GIVEN WARD
K NURP,NRMBD S NURP(1)=1,NURP(2)=21,NURP(3)=41,NURP(4)=61,NURP(5)=81 W !,"Unit "_NPWARD_" has the following rooms:",! F NURSX=0:0 S NURSX=$O(NMRC(NURSX)) Q:NURSX'<21!'(NURSX>0) D
. W ! W:$G(NMRC($G(NURP(1))))'="" NURP(1),". ",?6,$G(NMRC(NURP(1))) W:$G(NMRC($G(NURP(2))))'="" ?16,NURP(2),". ",$G(NMRC(NURP(2))) W:$G(NMRC($G(NURP(3))))'="" ?33,NURP(3),". ",$G(NMRC(NURP(3)))
. W:$G(NMRC($G(NURP(4))))'="" ?49,NURP(4),". ",$G(NMRC(NURP(4))) W:$G(NMRC($G(NURP(5))))'="" ?65,NURP(5),". ",$G(NMRC(NURP(5)))
. S NURP(1)=(NURP(1)+1),NURP(2)=(NURP(2)+1),NURP(3)=(NURP(3)+1),NURP(4)=(NURP(4)+1),NURP(5)=(NURP(5)+1)
. Q
W !!,"Select the NUMBER(S) of the rooms: "
R NURRMST:DTIME S:'$T NURRMST="^" I "^"[NURRMST S:NURRMST["^" NURQUIT=1 Q
W ! I NURRMST?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 '(NURRMST?.N!(NURRMST?.NP&(NURRMST["-"!(NURRMST[",")))) W $C(7)," ??" G EN3
F NURI=1:1 S NURLEN=$P(NURRMST,",",NURI) Q:NURLEN="" S NURLEN(1)=$P(NURLEN,"-",2)_"+"_NURLEN F NURX=+NURLEN:1:+NURLEN(1) S:'$D(NMRC(NURX)) NURQUIT=1 S:$D(NMRC(NURX)) NRMBD(NMRC(NURX))=""
I NURQUIT S NURQUIT=0 G EN3
Q
QUIT ;
K NURP,NDA,ND1,NWLOC,NURSY,NURSX,NURRMST,NURI,NURLEN,NORM,NMRC,NURX,NACT,NASK,RMSEL,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCUT0 3301 printed Oct 16, 2024@18:21:41 Page 2
NURCUT0 ;HIRMFO/MD,RM,FT-PATIENT SELECTION UTILITY BY WARD, ROOM OR SINGLE PATIENT ;7/24/97
+1 ;;4.0;NURSING SERVICE;**2,7,21**;Apr 25, 1997
WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE WARD, 2. SELECTED ROOMS ON WARD, 3. PATIENT
+1 SET (NUROUT,NURQUIT)=0
WRITE !,"By (U)nit, (S)elected unit rooms, or (P)atient? "
READ NUREDB:DTIME
IF "^"[NUREDB!('$TEST)
SET (NUROUT,NURQUIT)=1
QUIT
+2 if NUREDB?1L
SET NUREDB=$CHAR($ASCII(NUREDB)-32)
IF "Uu"[NUREDB!("Ss"[NUREDB)!("Pp"[NUREDB)
GOTO WP1
+3 IF NUREDB?1"?".E
GOTO WARDPAT
+4 WRITE !,$CHAR(7),?5,"INVALID ENTRY ??"
GOTO WARDPAT
WP1 ;
+1 IF "Uu"[NUREDB!("Ss"[NUREDB)
DO WARDSEL
if NURQUIT
QUIT
if $GET(NORM)
GOTO WARDPAT
GOTO QUIT
+2 DO PATDAT
IF +Y'>0
WRITE !
GOTO WARDPAT
+3 GOTO QUIT
WARDSEL ; SELECT WARD TO BE SEARCHED
+1 WRITE !
SET NORM=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)"
+2 SET DIC("A")="Select Unit: "
+3 DO ^DIC
KILL DIC
IF X="^"!(+Y'>0)
if $DATA(NURLOCSW)
SET NURQUIT=1
if NURQUIT=1
QUIT
WRITE !
GOTO WARDPAT
+4 WRITE !
SET (NURWARD,NPWARD)=+Y
SET DFN=$ORDER(^NURSF(214,"E",NURWARD,0))
DO EN6^NURSAUTL
+5 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
+6 IF DFN=""
WRITE !,$CHAR(7),"**** NO PATIENTS REGISTERED ON UNIT ",NPWARD," ****"
SET NURQUIT=1
QUIT
+7 if "Uu"[NUREDB
QUIT
+8 KILL NRM
FOR NDA=0:0
SET NDA=$ORDER(^NURSF(211.4,+Y,3,NDA))
if NDA'>0
QUIT
SET NWLOC=$PIECE(^NURSF(211.4,+Y,3,NDA,0),"^")
DO RMST
+9 KILL NMRC
SET NURSY=""
FOR NURSX=1:1
SET NURSY=$ORDER(NRM(NURSY))
if NURSY=""
QUIT
SET NMRC(NURSX)=NURSY
+10 KILL NRM
SET NORM=$SELECT($ORDER(NMRC(""))'="":0,1:1)
if NORM
WRITE !,$CHAR(7),"NO ROOMS ON THIS UNIT",!
if NORM
QUIT
DO EN3
SET NORM=$SELECT($ORDER(NRMBD(""))'="":0,1:1)
if NORM&('NURQUIT)
WRITE !!,$CHAR(7),"NO ROOMS SELECTED CANNOT RUN THIS REPORT.",!
KILL NMRC
+11 QUIT
RMST ;
+1 IF $DATA(^DG(405.4,0))
FOR ND1=0:0
SET ND1=$ORDER(^DG(405.4,"W",NWLOC,ND1))
if ND1'>0
QUIT
SET NRM=$SELECT($DATA(^DG(405.4,ND1,0)):$PIECE($PIECE(^(0),"^"),"-",1,2),1:"")
IF NRM'=""
SET NRM(NRM)=""
+2 QUIT
PATDAT ; SINGLE PATIENT SELECTION
+1 if '$DATA(NACT)
SET NACT=1
+2 SET DIC(0)="EQMZ"
SET NASK=1
DO EN7^NURSCUTL
IF DFN'>0
SET NURQUIT=1
QUIT
+3 SET DFN=+Y
+4 QUIT
EN3 ; SELECT ROOMS ON A GIVEN WARD
+1 KILL NURP,NRMBD
SET NURP(1)=1
SET NURP(2)=21
SET NURP(3)=41
SET NURP(4)=61
SET NURP(5)=81
WRITE !,"Unit "_NPWARD_" has the following rooms:",!
FOR NURSX=0:0
SET NURSX=$ORDER(NMRC(NURSX))
if NURSX'<21!'(NURSX>0)
QUIT
Begin DoDot:1
+2 WRITE !
if $GET(NMRC($GET(NURP(1))))'=""
WRITE NURP(1),". ",?6,$GET(NMRC(NURP(1)))
if $GET(NMRC($GET(NURP(2))))'=""
WRITE ?16,NURP(2),". ",$GET(NMRC(NURP(2)))
if $GET(NMRC($GET(NURP(3))))'=""
WRITE ?33,NURP(3),". ",$GET(NMRC(NURP(3)))
+3 if $GET(NMRC($GET(NURP(4))))'=""
WRITE ?49,NURP(4),". ",$GET(NMRC(NURP(4)))
if $GET(NMRC($GET(NURP(5))))'=""
WRITE ?65,NURP(5),". ",$GET(NMRC(NURP(5)))
+4 SET NURP(1)=(NURP(1)+1)
SET NURP(2)=(NURP(2)+1)
SET NURP(3)=(NURP(3)+1)
SET NURP(4)=(NURP(4)+1)
SET NURP(5)=(NURP(5)+1)
+5 QUIT
End DoDot:1
+6 WRITE !!,"Select the NUMBER(S) of the rooms: "
+7 READ NURRMST:DTIME
if '$TEST
SET NURRMST="^"
IF "^"[NURRMST
if NURRMST["^"
SET NURQUIT=1
QUIT
+8 WRITE !
IF NURRMST?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
+9 IF '(NURRMST?.N!(NURRMST?.NP&(NURRMST["-"!(NURRMST[","))))
WRITE $CHAR(7)," ??"
GOTO EN3
+10 FOR NURI=1:1
SET NURLEN=$PIECE(NURRMST,",",NURI)
if NURLEN=""
QUIT
SET NURLEN(1)=$PIECE(NURLEN,"-",2)_"+"_NURLEN
FOR NURX=+NURLEN:1:+NURLEN(1)
if '$DATA(NMRC(NURX))
SET NURQUIT=1
if $DATA(NMRC(NURX))
SET NRMBD(NMRC(NURX))=""
+11 IF NURQUIT
SET NURQUIT=0
GOTO EN3
+12 QUIT
QUIT ;
+1 KILL NURP,NDA,ND1,NWLOC,NURSY,NURSX,NURRMST,NURI,NURLEN,NORM,NMRC,NURX,NACT,NASK,RMSEL,X,Y
+2 QUIT
