source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURACEW1.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1NURACEW1 ;HIRMFO/RM-CHECK FOR PATIENTS NOT CLASSIFIED BY WARD...cont. ;MAY 1985
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; ENTRY FROM NURACEW0, ASK TO CLASSIFY THOSE NOT CLASSIFIED TODAY
4 G:('$D(NURSTABL(1))) QUIT2
5 D SORTTABL S NURQUIT=0 F TCNT=1:1 D:$D(NURSTABL(TCNT))&'NURQUIT CHKCONT1 Q:'$D(NURSTABL(TCNT))!NURQUIT
6 G QUIT2
7CHKCONT1 ;
8 W !!,$P(NURSTABL(TCNT),"^",2),?$X+10,ROOMTABL(TCNT)," OK" S %=1 D YN^DICN
9 I %=-1 S NURQUIT=1 Q
10 I %=1 S TABLSW=0 D EN1^NURACE0 Q
11 I %=2 D CHKCONT2 Q
12 W !,"ANSWER YES OR NO" G CHKCONT1
13CHKCONT2 ;
14 W !!,"Do you wish to stop looping through names" S %=1 D YN^DICN
15 I %=-1!(%=1) S NURQUIT=1 Q
16 Q:%=2
17 W !,"ANSWER YES OR NO" G CHKCONT2
18QUIT2 ; KILL REST OF VARIABLES USED IN ROUTINE
19 I $D(NURSTABL(1))&'PRTSW W !!,?16,"**** ROUTINE FINISHED ****",!!
20 K %,NS1,NURSA,NURSTABL,NURSTRAN,NURSX,TABLSW,TCNT
21 Q
22SORTTABL ; THIS PUTS THE ARRAYS IN ORDER BY ROOM-BED (IF EXIST) OR NAME
23 K ^TMP($J) S NURSDTSW=0 S:$D(DATETABL) NURSDTSW=1
24 F NURSZ=1:1:NURSCNT D SETSORT
25 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
26Q K ^TMP($J) Q
27RESETARR ;
28 S ROOMTABL(NURSX)=$S(NURSZ'=" EMPTY":NURSZ,1:"")
29 S NURSTABL(NURSX)=DFN_"^"_NURSY
30 S:NURSDTSW DATETABL(NURSX)=^TMP($J,NURSZ,NURSY,+NURSTABL(NURSX))
31 Q
32SETSORT ;
33 Q:'$D(NURSTABL(NURSZ))!($P(NURSTABL(NURSZ),"^",2)="") S NURSWHO=$P(NURSTABL(NURSZ),"^",2)
34 S ^TMP($J,$S(ROOMTABL(NURSZ)'="":ROOMTABL(NURSZ),1:" EMPTY"),NURSWHO,+NURSTABL(NURSZ))=$S('NURSDTSW:"",1:DATETABL(NURSZ))
35 Q
Note: See TracBrowser for help on using the repository browser.