- 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 Feb 18, 2025@23:47:22 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