source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURACEW.m@ 862

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1NURACEW ;HIRMFO/RM,MD,FT-CLASSIFY PATIENTS ON A GIVEN WARD ;8/14/96 09:57
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ;
4 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
5 D QUIT
6 S REVSW=0
7 G EDIT
8EN2 ; ENTRY FROM OPTION NURAPC-REVWRD
9 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
10 D QUIT
11 S REVSW=1
12EDIT ; SELECT WARD TO BE SEARCHED
13 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)"
14 D ^DIC K DIC I (X="^")!(+Y'>0) K REVSW Q
15 S WARDNAM=+Y,DFN=$O(^NURSF(214,"AF","A",WARDNAM,0))
16 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
17 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
18 K NURSTABL S TCNT=0
19BGNRPT ; VALIDATE EACH PATIENT REGISTERED ON WARD
20 S XRMBD="" D 1^VADPT
21 S:VAIN(5)'="" XRMBD=VAIN(5)
22 S TCNT=TCNT+1,NURSTABL(TCNT)=DFN_"^"_VADM(1),ROOMTABL(TCNT)=XRMBD,NURSCNT=TCNT
23READNXT ; GET NEXT PATIENT
24 S DFN=$O(^NURSF(214,"AF","A",WARDNAM,DFN))
25 G:DFN="" CHKENTR
26 G BGNRPT
27QUIT ;KILL LOCAL VARIABLES
28 K X,Y,POP,WARDNAM,DIC,DFN,NOPATSW,I
29 Q
30CHKENTR ;ASK TO CLASSIFY ON THE WARD
31 D QUIT
32 G:('$D(NURSTABL(1))) QUIT2
33 W !,"Begin updating patient classifications."
34 S TCNT=0
35 D SORTTABL^NURACEW1
36CHKCONT ;
37 S TCNT=TCNT+1
38 G:('$D(NURSTABL(TCNT))) QUIT2
39CHKCONT1 ;
40 W !!,$P(NURSTABL(TCNT),"^",2),?$X+10,ROOMTABL(TCNT)," OK? YES// " R NURSX:DTIME
41 S:NURSX?1L NURSX=$C($A(NURSX)-32) I (NURSX="^")!('$T) G QUIT2
42 I ((NURSX="")!($E(NURSX,1)="Y")) S TABLSW=0 D:REVSW=0 EN1^NURACE0 D:REVSW=1 EN2^NURACE0 G CHKCONT
43 G:NURSX?1"N".E CHKCONT2
44 W !,"ANSWER YES OR NO" G CHKCONT1
45CHKCONT2 ;
46 W !!,"Do you wish to stop looping through names? YES//" R NURSX:DTIME
47 S:NURSX?1L NURSX=$C($A(NURSX)-32) I (('$T)!(NURSX="")!($E(NURSX,1)="Y")!(NURSX="^")) G QUIT2
48 I NURSX?1"N".E G CHKCONT
49 W !,"ANSWER YES OR NO" G CHKCONT2
50QUIT2 ; KILL THE REST OF THE VARIABLES
51 I $D(NURSTABL(1)) W !!,?16,"**** ROUTINE FINISHED ****",!!
52 K NURSTABL,NURSX,TABLSW,TCNT,XRMBD,REVSW,NURSCNT,NURSY,NURSZ,ROOMTABL,NURSDTSW,NURSWHO,VAROOT
53 Q
Note: See TracBrowser for help on using the repository browser.