NURACEW ;HIRMFO/RM,MD,FT-CLASSIFY PATIENTS ON A GIVEN WARD ;8/14/96 09:57
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
D QUIT
S REVSW=0
G EDIT
EN2 ; ENTRY FROM OPTION NURAPC-REVWRD
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
D QUIT
S REVSW=1
EDIT ; SELECT WARD TO BE SEARCHED
S DIC="^NURSF(211.4,",DIC("A")="Enter UNIT you want to search: ",DIC(0)="AEQMZ",DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)"
D ^DIC K DIC I (X="^")!(+Y'>0) K REVSW Q
S WARDNAM=+Y,DFN=$O(^NURSF(214,"AF","A",WARDNAM,0))
; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
S NPWARD=WARDNAM D EN6^NURSAUTL I DFN="" W !,*7,"**** NO PATIENTS REGISTERED ON WARD ",NPWARD," ****" K WARDNAM,NPWARD,DA,NOPATSW,REVSW,DIC,DIC Q
K NURSTABL S TCNT=0
BGNRPT ; VALIDATE EACH PATIENT REGISTERED ON WARD
S XRMBD="" D 1^VADPT
S:VAIN(5)'="" XRMBD=VAIN(5)
S TCNT=TCNT+1,NURSTABL(TCNT)=DFN_"^"_VADM(1),ROOMTABL(TCNT)=XRMBD,NURSCNT=TCNT
READNXT ; GET NEXT PATIENT
S DFN=$O(^NURSF(214,"AF","A",WARDNAM,DFN))
G:DFN="" CHKENTR
G BGNRPT
QUIT ;KILL LOCAL VARIABLES
K X,Y,POP,WARDNAM,DIC,DFN,NOPATSW,I
Q
CHKENTR ;ASK TO CLASSIFY ON THE WARD
D QUIT
G:('$D(NURSTABL(1))) QUIT2
W !,"Begin updating patient classifications."
S TCNT=0
D SORTTABL^NURACEW1
CHKCONT ;
S TCNT=TCNT+1
G:('$D(NURSTABL(TCNT))) QUIT2
CHKCONT1 ;
W !!,$P(NURSTABL(TCNT),"^",2),?$X+10,ROOMTABL(TCNT)," OK? YES// " R NURSX:DTIME
S:NURSX?1L NURSX=$C($A(NURSX)-32) I (NURSX="^")!('$T) G QUIT2
I ((NURSX="")!($E(NURSX,1)="Y")) S TABLSW=0 D:REVSW=0 EN1^NURACE0 D:REVSW=1 EN2^NURACE0 G CHKCONT
G:NURSX?1"N".E CHKCONT2
W !,"ANSWER YES OR NO" G CHKCONT1
CHKCONT2 ;
W !!,"Do you wish to stop looping through names? YES//" R NURSX:DTIME
S:NURSX?1L NURSX=$C($A(NURSX)-32) I (('$T)!(NURSX="")!($E(NURSX,1)="Y")!(NURSX="^")) G QUIT2
I NURSX?1"N".E G CHKCONT
W !,"ANSWER YES OR NO" G CHKCONT2
QUIT2 ; KILL THE REST OF THE VARIABLES
I $D(NURSTABL(1)) W !!,?16,"**** ROUTINE FINISHED ****",!!
K NURSTABL,NURSX,TABLSW,TCNT,XRMBD,REVSW,NURSCNT,NURSY,NURSZ,ROOMTABL,NURSDTSW,NURSWHO,VAROOT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURACEW 2213 printed Nov 22, 2024@17:29:06 Page 2
NURACEW ;HIRMFO/RM,MD,FT-CLASSIFY PATIENTS ON A GIVEN WARD ;8/14/96 09:57
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ;
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 DO QUIT
+3 SET REVSW=0
+4 GOTO EDIT
EN2 ; ENTRY FROM OPTION NURAPC-REVWRD
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 DO QUIT
+3 SET REVSW=1
EDIT ; SELECT WARD TO BE SEARCHED
+1 SET DIC="^NURSF(211.4,"
SET DIC("A")="Enter UNIT you want to search: "
SET DIC(0)="AEQMZ"
SET DIC("S")="I $S('$D(^(""I"")):1,$P(^(""I""),U)'=""I"":1,1:0),$S('$D(^(1)):1,$P(^(1),U)=""A"":1,1:0)"
+2 DO ^DIC
KILL DIC
IF (X="^")!(+Y'>0)
KILL REVSW
QUIT
+3 SET WARDNAM=+Y
SET DFN=$ORDER(^NURSF(214,"AF","A",WARDNAM,0))
+4 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
+5 SET NPWARD=WARDNAM
DO EN6^NURSAUTL
IF DFN=""
WRITE !,*7,"**** NO PATIENTS REGISTERED ON WARD ",NPWARD," ****"
KILL WARDNAM,NPWARD,DA,NOPATSW,REVSW,DIC,DIC
QUIT
+6 KILL NURSTABL
SET TCNT=0
BGNRPT ; VALIDATE EACH PATIENT REGISTERED ON WARD
+1 SET XRMBD=""
DO 1^VADPT
+2 if VAIN(5)'=""
SET XRMBD=VAIN(5)
+3 SET TCNT=TCNT+1
SET NURSTABL(TCNT)=DFN_"^"_VADM(1)
SET ROOMTABL(TCNT)=XRMBD
SET NURSCNT=TCNT
READNXT ; GET NEXT PATIENT
+1 SET DFN=$ORDER(^NURSF(214,"AF","A",WARDNAM,DFN))
+2 if DFN=""
GOTO CHKENTR
+3 GOTO BGNRPT
QUIT ;KILL LOCAL VARIABLES
+1 KILL X,Y,POP,WARDNAM,DIC,DFN,NOPATSW,I
+2 QUIT
CHKENTR ;ASK TO CLASSIFY ON THE WARD
+1 DO QUIT
+2 if ('$DATA(NURSTABL(1)))
GOTO QUIT2
+3 WRITE !,"Begin updating patient classifications."
+4 SET TCNT=0
+5 DO SORTTABL^NURACEW1
CHKCONT ;
+1 SET TCNT=TCNT+1
+2 if ('$DATA(NURSTABL(TCNT)))
GOTO QUIT2
CHKCONT1 ;
+1 WRITE !!,$PIECE(NURSTABL(TCNT),"^",2),?$X+10,ROOMTABL(TCNT)," OK? YES// "
READ NURSX:DTIME
+2 if NURSX?1L
SET NURSX=$CHAR($ASCII(NURSX)-32)
IF (NURSX="^")!('$TEST)
GOTO QUIT2
+3 IF ((NURSX="")!($EXTRACT(NURSX,1)="Y"))
SET TABLSW=0
if REVSW=0
DO EN1^NURACE0
if REVSW=1
DO EN2^NURACE0
GOTO CHKCONT
+4 if NURSX?1"N".E
GOTO CHKCONT2
+5 WRITE !,"ANSWER YES OR NO"
GOTO CHKCONT1
CHKCONT2 ;
+1 WRITE !!,"Do you wish to stop looping through names? YES//"
READ NURSX:DTIME
+2 if NURSX?1L
SET NURSX=$CHAR($ASCII(NURSX)-32)
IF (('$TEST)!(NURSX="")!($EXTRACT(NURSX,1)="Y")!(NURSX="^"))
GOTO QUIT2
+3 IF NURSX?1"N".E
GOTO CHKCONT
+4 WRITE !,"ANSWER YES OR NO"
GOTO CHKCONT2
QUIT2 ; KILL THE REST OF THE VARIABLES
+1 IF $DATA(NURSTABL(1))
WRITE !!,?16,"**** ROUTINE FINISHED ****",!!
+2 KILL NURSTABL,NURSX,TABLSW,TCNT,XRMBD,REVSW,NURSCNT,NURSY,NURSZ,ROOMTABL,NURSDTSW,NURSWHO,VAROOT
+3 QUIT
