36 lines
1.6 KiB
Mathematica
36 lines
1.6 KiB
Mathematica
NURACEW1 ;HIRMFO/RM-CHECK FOR PATIENTS NOT CLASSIFIED BY WARD...cont. ;MAY 1985
|
|
;;4.0;NURSING SERVICE;;Apr 25, 1997
|
|
EN1 ; ENTRY FROM NURACEW0, ASK TO CLASSIFY THOSE NOT CLASSIFIED TODAY
|
|
G:('$D(NURSTABL(1))) QUIT2
|
|
D SORTTABL S NURQUIT=0 F TCNT=1:1 D:$D(NURSTABL(TCNT))&'NURQUIT CHKCONT1 Q:'$D(NURSTABL(TCNT))!NURQUIT
|
|
G QUIT2
|
|
CHKCONT1 ;
|
|
W !!,$P(NURSTABL(TCNT),"^",2),?$X+10,ROOMTABL(TCNT)," OK" S %=1 D YN^DICN
|
|
I %=-1 S NURQUIT=1 Q
|
|
I %=1 S TABLSW=0 D EN1^NURACE0 Q
|
|
I %=2 D CHKCONT2 Q
|
|
W !,"ANSWER YES OR NO" G CHKCONT1
|
|
CHKCONT2 ;
|
|
W !!,"Do you wish to stop looping through names" S %=1 D YN^DICN
|
|
I %=-1!(%=1) S NURQUIT=1 Q
|
|
Q:%=2
|
|
W !,"ANSWER YES OR NO" G CHKCONT2
|
|
QUIT2 ; KILL REST OF VARIABLES USED IN ROUTINE
|
|
I $D(NURSTABL(1))&'PRTSW W !!,?16,"**** ROUTINE FINISHED ****",!!
|
|
K %,NS1,NURSA,NURSTABL,NURSTRAN,NURSX,TABLSW,TCNT
|
|
Q
|
|
SORTTABL ; THIS PUTS THE ARRAYS IN ORDER BY ROOM-BED (IF EXIST) OR NAME
|
|
K ^TMP($J) S NURSDTSW=0 S:$D(DATETABL) NURSDTSW=1
|
|
F NURSZ=1:1:NURSCNT D SETSORT
|
|
S NURSX=0,NURSZ="" F NURSA=0:0 S NURSZ=$O(^TMP($J,NURSZ)) Q:NURSZ="" S NURSY="" F NURSA=0:0 S NURSY=$O(^TMP($J,NURSZ,NURSY)) Q:NURSY="" F DFN=0:0 S DFN=$O(^TMP($J,NURSZ,NURSY,DFN)) Q:DFN'>0 S NURSX=NURSX+1 D RESETARR
|
|
Q K ^TMP($J) Q
|
|
RESETARR ;
|
|
S ROOMTABL(NURSX)=$S(NURSZ'=" EMPTY":NURSZ,1:"")
|
|
S NURSTABL(NURSX)=DFN_"^"_NURSY
|
|
S:NURSDTSW DATETABL(NURSX)=^TMP($J,NURSZ,NURSY,+NURSTABL(NURSX))
|
|
Q
|
|
SETSORT ;
|
|
Q:'$D(NURSTABL(NURSZ))!($P(NURSTABL(NURSZ),"^",2)="") S NURSWHO=$P(NURSTABL(NURSZ),"^",2)
|
|
S ^TMP($J,$S(ROOMTABL(NURSZ)'="":ROOMTABL(NURSZ),1:" EMPTY"),NURSWHO,+NURSTABL(NURSZ))=$S('NURSDTSW:"",1:DATETABL(NURSZ))
|
|
Q
|