[613] | 1 | NURACEW0 ;HIRMFO/RM,MD,FT-DRIVER CHECK FOR PATIENTS NOT CLASSIFIED BY WARD ;8/14/96 09:59
|
---|
| 2 | ;;4.0;NURSING SERVICE;;Apr 25, 1997
|
---|
| 3 | EN1 ; ENTER ROUTINE FROM MENU OPTION NURAPP-UNCLOC
|
---|
| 4 | Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
---|
| 5 | S (NURQUEUE,OUTSW)=0,PRTSW=1
|
---|
| 6 | D EDIT I OUTSW D QUIT Q
|
---|
| 7 | W ! D QUEUE,EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
|
---|
| 8 | PR ;
|
---|
| 9 | S (NURQUIT,NURSW1)=0 G SORT
|
---|
| 10 | EN2 ; ENTRY FROM OPTION NURAPC-UNCWRD
|
---|
| 11 | Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
---|
| 12 | S (NURQUEUE,PRTSW,OUTSW)=0
|
---|
| 13 | D EDIT I OUTSW D QUIT Q
|
---|
| 14 | D WAIT^DICD G SORT
|
---|
| 15 | EDIT ; SELECT WARD TO SEARCH
|
---|
| 16 | 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)"
|
---|
| 17 | W ! D ^DIC K DIC
|
---|
| 18 | I (X="^")!(+Y'>0) S OUTSW=1 Q
|
---|
| 19 | S WARDNAM=+Y
|
---|
| 20 | ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
|
---|
| 21 | I $O(^NURSF(214,"AF","A",WARDNAM,0))'>0 S NPWARD=WARDNAM D EN6^NURSAUTL W !,*7,"**** NO PATIENTS REGISTERED ON UNIT ",NPWARD," ****" S OUTSW=1 Q
|
---|
| 22 | K NURSTABL S TCNT=0
|
---|
| 23 | Q
|
---|
| 24 | QUEUE ; QUEUE REPORT TO TASKMAN
|
---|
| 25 | S ZTRTN="PR^NURACEW0"
|
---|
| 26 | Q
|
---|
| 27 | PRINT ; PRINT REPORT FOR PTS. NOT CLASSIFIED BY WARD
|
---|
| 28 | S PAGE=0 U IO D HEADER
|
---|
| 29 | I '$D(NURSTABL(1)) W !!,"ALL PATIENTS ON THIS UNIT ARE CLASSIFIED",!! G Q
|
---|
| 30 | D SORTTABL^NURACEW1 F TCNT=1:1 D:$D(NURSTABL(TCNT))&'NURQUIT CHKCONT Q:'$D(NURSTABL(TCNT))!NURQUIT
|
---|
| 31 | Q R:'NURQUEUE&(IO'="")&($E(IOST)="C")&('NURQUIT) !!,"Press return to continue ",X:DTIME
|
---|
| 32 | D QUIT2^NURACEW1
|
---|
| 33 | Q
|
---|
| 34 | CHKCONT ;
|
---|
| 35 | W !,ROOMTABL(TCNT),?17,$E($P(NURSTABL(TCNT),"^",2),1,20)
|
---|
| 36 | I NURSDTSW S Y=DATETABL(TCNT) D:+Y D^DIQ W ?45,Y
|
---|
| 37 | S DFN=+NURSTABL(TCNT) D ^NURSAPCH W ?70,NURSX
|
---|
| 38 | D:$Y>(IOSL-6) HEADER
|
---|
| 39 | Q
|
---|
| 40 | HEADER ; PRINT REPORT HEADER
|
---|
| 41 | I 'NURQUEUE,$E(IOST)="C",NURSW1 W $C(7),! R X:DTIME I '$T!(X="^") S NURQUIT=1 Q
|
---|
| 42 | S PAGE=PAGE+1 S:'NURSW1 NURSW1=1
|
---|
| 43 | W @IOF,$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3),?17,"CURRENT UNCLASSIFIED PATIENT REPORT FOR LOCATION " S NPWARD=WARDNAM D EN6^NURSAUTL W NPWARD,?73,"PAGE: ",PAGE
|
---|
| 44 | W !!,"ROOM-BED",?17,"PATIENT",?45,"LAST CLASSIFIED",?68,"ABSENCE",!
|
---|
| 45 | S $P(NURSXX,"-",80)="" W NURSXX
|
---|
| 46 | W !
|
---|
| 47 | Q
|
---|
| 48 | SORT ; CHECK TO SEE IF EACH PATIENT ON WARD IS VALID
|
---|
| 49 | F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",WARDNAM,DFN)) Q:DFN'>0 D BGNVIEW
|
---|
| 50 | G ENDIT
|
---|
| 51 | BGNVIEW ;
|
---|
| 52 | S NBED=$S($D(^NURSF(214,DFN,0)):$P(^(0),"^",4),1:""),NBED(0)=$S(NBED="":"",$D(^NURSF(213.3,NBED,0)):$P(^(0),"^"),1:"")
|
---|
| 53 | Q:NBED(0)=""!(NBED(0)="HEMODIALYSIS")!(NBED(0)="DOMICILIARY")!(NBED(0)="RECOVERY ROOM")
|
---|
| 54 | D 1^VADPT S XRMBD=VAIN(5)
|
---|
| 55 | D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL
|
---|
| 56 | I NURSCLAS'>0 S DATEX="NOT CLASSIFIED YET",NWRDVAR="" G FILLTABL
|
---|
| 57 | S DATEX=$S('$D(^NURSA(214.6,NURSCLAS,0)):"",1:$P(^(0),"^",1)),NWRDVAR=$S($D(^NURSA(214.6,NURSCLAS,0)):$P(^(0),"^",8),1:"")
|
---|
| 58 | FILLTABL ; ADD PATIENT TO LIST OF PATIENTS ON WARD IF VALID
|
---|
| 59 | I DATEX<DT!(NWRDVAR'=WARDNAM) S TCNT=TCNT+1,NURSTABL(TCNT)=DFN_"^"_VADM(1),DATETABL(TCNT)=DATEX,ROOMTABL(TCNT)=XRMBD,NURSCNT=TCNT
|
---|
| 60 | Q
|
---|
| 61 | ENDIT ; EDIT PATIENTS NOT CLASSIFIED BY WARD
|
---|
| 62 | D EN1^NURACEW1:'PRTSW,PRINT:PRTSW D:PRTSW ^%ZISC
|
---|
| 63 | D QUIT Q
|
---|
| 64 | QUIT ;KILL LOCAL VARIABLES
|
---|
| 65 | D KVAR^VADPT K VA K DATEX,NURSCLAS,CHKVAR,WARDNAM,XRMBD,DATETABL,DIC,G,DFN,ROOMTABL,PAGE,NBED,NURSZ,NURSX,NURSCNT,NURSY,NURSDTSW,OUTSW,LINE,PRTSW,NURSWHO,NURQUEUE,NWRDVAR,NURQUIT,NURSW1,TCNT,ZTSK,NURSADM,NPWARD,NURSXX,VAROOT
|
---|
| 66 | Q
|
---|