NURACEW.m

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

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