- NURACEW0 ;HIRMFO/RM,MD,FT-DRIVER CHECK FOR PATIENTS NOT CLASSIFIED BY WARD ;8/14/96 09:59
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; ENTER ROUTINE FROM MENU OPTION NURAPP-UNCLOC
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NURQUEUE,OUTSW)=0,PRTSW=1
- D EDIT I OUTSW D QUIT Q
- W ! D QUEUE,EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- PR ;
- S (NURQUIT,NURSW1)=0 G SORT
- EN2 ; ENTRY FROM OPTION NURAPC-UNCWRD
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NURQUEUE,PRTSW,OUTSW)=0
- D EDIT I OUTSW D QUIT Q
- D WAIT^DICD G SORT
- EDIT ; SELECT WARD TO SEARCH
- 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)"
- W ! D ^DIC K DIC
- I (X="^")!(+Y'>0) S OUTSW=1 Q
- S WARDNAM=+Y
- ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
- 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
- K NURSTABL S TCNT=0
- Q
- QUEUE ; QUEUE REPORT TO TASKMAN
- S ZTRTN="PR^NURACEW0"
- Q
- PRINT ; PRINT REPORT FOR PTS. NOT CLASSIFIED BY WARD
- S PAGE=0 U IO D HEADER
- I '$D(NURSTABL(1)) W !!,"ALL PATIENTS ON THIS UNIT ARE CLASSIFIED",!! G Q
- D SORTTABL^NURACEW1 F TCNT=1:1 D:$D(NURSTABL(TCNT))&'NURQUIT CHKCONT Q:'$D(NURSTABL(TCNT))!NURQUIT
- Q R:'NURQUEUE&(IO'="")&($E(IOST)="C")&('NURQUIT) !!,"Press return to continue ",X:DTIME
- D QUIT2^NURACEW1
- Q
- CHKCONT ;
- W !,ROOMTABL(TCNT),?17,$E($P(NURSTABL(TCNT),"^",2),1,20)
- I NURSDTSW S Y=DATETABL(TCNT) D:+Y D^DIQ W ?45,Y
- S DFN=+NURSTABL(TCNT) D ^NURSAPCH W ?70,NURSX
- D:$Y>(IOSL-6) HEADER
- Q
- I 'NURQUEUE,$E(IOST)="C",NURSW1 W $C(7),! R X:DTIME I '$T!(X="^") S NURQUIT=1 Q
- S PAGE=PAGE+1 S:'NURSW1 NURSW1=1
- 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
- W !!,"ROOM-BED",?17,"PATIENT",?45,"LAST CLASSIFIED",?68,"ABSENCE",!
- S $P(NURSXX,"-",80)="" W NURSXX
- W !
- Q
- SORT ; CHECK TO SEE IF EACH PATIENT ON WARD IS VALID
- F DFN=0:0 S DFN=$O(^NURSF(214,"AF","A",WARDNAM,DFN)) Q:DFN'>0 D BGNVIEW
- G ENDIT
- BGNVIEW ;
- 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:"")
- Q:NBED(0)=""!(NBED(0)="HEMODIALYSIS")!(NBED(0)="DOMICILIARY")!(NBED(0)="RECOVERY ROOM")
- D 1^VADPT S XRMBD=VAIN(5)
- D EN6^NURSCUTL S NURSCLAS("CL")=1 D EN2^NURSCUTL
- I NURSCLAS'>0 S DATEX="NOT CLASSIFIED YET",NWRDVAR="" G FILLTABL
- 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:"")
- FILLTABL ; ADD PATIENT TO LIST OF PATIENTS ON WARD IF VALID
- I DATEX<DT!(NWRDVAR'=WARDNAM) S TCNT=TCNT+1,NURSTABL(TCNT)=DFN_"^"_VADM(1),DATETABL(TCNT)=DATEX,ROOMTABL(TCNT)=XRMBD,NURSCNT=TCNT
- Q
- ENDIT ; EDIT PATIENTS NOT CLASSIFIED BY WARD
- D EN1^NURACEW1:'PRTSW,PRINT:PRTSW D:PRTSW ^%ZISC
- D QUIT Q
- QUIT ;KILL LOCAL VARIABLES
- 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURACEW0 3316 printed Feb 18, 2025@23:45:28 Page 2
- NURACEW0 ;HIRMFO/RM,MD,FT-DRIVER CHECK FOR PATIENTS NOT CLASSIFIED BY WARD ;8/14/96 09:59
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 ; ENTER ROUTINE FROM MENU OPTION NURAPP-UNCLOC
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET (NURQUEUE,OUTSW)=0
- SET PRTSW=1
- +3 DO EDIT
- IF OUTSW
- DO QUIT
- QUIT
- +4 WRITE !
- DO QUEUE
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- PR ;
- +1 SET (NURQUIT,NURSW1)=0
- GOTO SORT
- EN2 ; ENTRY FROM OPTION NURAPC-UNCWRD
- +1 if '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +2 SET (NURQUEUE,PRTSW,OUTSW)=0
- +3 DO EDIT
- IF OUTSW
- DO QUIT
- QUIT
- +4 DO WAIT^DICD
- GOTO SORT
- EDIT ; SELECT WARD TO SEARCH
- +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 WRITE !
- DO ^DIC
- KILL DIC
- +3 IF (X="^")!(+Y'>0)
- SET OUTSW=1
- QUIT
- +4 SET WARDNAM=+Y
- +5 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
- +6 IF $ORDER(^NURSF(214,"AF","A",WARDNAM,0))'>0
- SET NPWARD=WARDNAM
- DO EN6^NURSAUTL
- WRITE !,*7,"**** NO PATIENTS REGISTERED ON UNIT ",NPWARD," ****"
- SET OUTSW=1
- QUIT
- +7 KILL NURSTABL
- SET TCNT=0
- +8 QUIT
- QUEUE ; QUEUE REPORT TO TASKMAN
- +1 SET ZTRTN="PR^NURACEW0"
- +2 QUIT
- PRINT ; PRINT REPORT FOR PTS. NOT CLASSIFIED BY WARD
- +1 SET PAGE=0
- USE IO
- DO HEADER
- +2 IF '$DATA(NURSTABL(1))
- WRITE !!,"ALL PATIENTS ON THIS UNIT ARE CLASSIFIED",!!
- GOTO Q
- +3 DO SORTTABL^NURACEW1
- FOR TCNT=1:1
- if $DATA(NURSTABL(TCNT))&'NURQUIT
- DO CHKCONT
- if '$DATA(NURSTABL(TCNT))!NURQUIT
- QUIT
- Q if 'NURQUEUE&(IO'="")&($EXTRACT(IOST)="C")&('NURQUIT)
- READ !!,"Press return to continue ",X:DTIME
- +1 DO QUIT2^NURACEW1
- +2 QUIT
- CHKCONT ;
- +1 WRITE !,ROOMTABL(TCNT),?17,$EXTRACT($PIECE(NURSTABL(TCNT),"^",2),1,20)
- +2 IF NURSDTSW
- SET Y=DATETABL(TCNT)
- if +Y
- DO D^DIQ
- WRITE ?45,Y
- +3 SET DFN=+NURSTABL(TCNT)
- DO ^NURSAPCH
- WRITE ?70,NURSX
- +4 if $Y>(IOSL-6)
- DO HEADER
- +5 QUIT
- +1 IF 'NURQUEUE
- IF $EXTRACT(IOST)="C"
- IF NURSW1
- WRITE $CHAR(7),!
- READ X:DTIME
- IF '$TEST!(X="^")
- SET NURQUIT=1
- QUIT
- +2 SET PAGE=PAGE+1
- if 'NURSW1
- SET NURSW1=1
- +3 WRITE @IOF,$EXTRACT(DT,4,5),"/",$EXTRACT(DT,6,7),"/",$EXTRACT(DT,2,3),?17,"CURRENT UNCLASSIFIED PATIENT REPORT FOR LOCATION "
- SET NPWARD=WARDNAM
- DO EN6^NURSAUTL
- WRITE NPWARD,?73,"PAGE: ",PAGE
- +4 WRITE !!,"ROOM-BED",?17,"PATIENT",?45,"LAST CLASSIFIED",?68,"ABSENCE",!
- +5 SET $PIECE(NURSXX,"-",80)=""
- WRITE NURSXX
- +6 WRITE !
- +7 QUIT
- SORT ; CHECK TO SEE IF EACH PATIENT ON WARD IS VALID
- +1 FOR DFN=0:0
- SET DFN=$ORDER(^NURSF(214,"AF","A",WARDNAM,DFN))
- if DFN'>0
- QUIT
- DO BGNVIEW
- +2 GOTO ENDIT
- BGNVIEW ;
- +1 SET NBED=$SELECT($DATA(^NURSF(214,DFN,0)):$PIECE(^(0),"^",4),1:"")
- SET NBED(0)=$SELECT(NBED="":"",$DATA(^NURSF(213.3,NBED,0)):$PIECE(^(0),"^"),1:"")
- +2 if NBED(0)=""!(NBED(0)="HEMODIALYSIS")!(NBED(0)="DOMICILIARY")!(NBED(0)="RECOVERY ROOM")
- QUIT
- +3 DO 1^VADPT
- SET XRMBD=VAIN(5)
- +4 DO EN6^NURSCUTL
- SET NURSCLAS("CL")=1
- DO EN2^NURSCUTL
- +5 IF NURSCLAS'>0
- SET DATEX="NOT CLASSIFIED YET"
- SET NWRDVAR=""
- GOTO FILLTABL
- +6 SET DATEX=$SELECT('$DATA(^NURSA(214.6,NURSCLAS,0)):"",1:$PIECE(^(0),"^",1))
- SET NWRDVAR=$SELECT($DATA(^NURSA(214.6,NURSCLAS,0)):$PIECE(^(0),"^",8),1:"")
- FILLTABL ; ADD PATIENT TO LIST OF PATIENTS ON WARD IF VALID
- +1 IF DATEX<DT!(NWRDVAR'=WARDNAM)
- SET TCNT=TCNT+1
- SET NURSTABL(TCNT)=DFN_"^"_VADM(1)
- SET DATETABL(TCNT)=DATEX
- SET ROOMTABL(TCNT)=XRMBD
- SET NURSCNT=TCNT
- +2 QUIT
- ENDIT ; EDIT PATIENTS NOT CLASSIFIED BY WARD
- +1 if 'PRTSW
- DO EN1^NURACEW1
- if PRTSW
- DO PRINT
- if PRTSW
- DO ^%ZISC
- +2 DO QUIT
- QUIT
- QUIT ;KILL LOCAL VARIABLES
- +1 DO KVAR^VADPT
- KILL VA
- KILL 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
- +2 QUIT