NURAAU2 ;HIRMFO/RM/MD-BACKUP IF NURAAU0 NOT RUN...AMIS 1106a ;6/5/97
;;4.0;NURSING SERVICE;**1,2,7,20,24,29**;Apr 25, 1997
; DONE BY: AS REQUIRED DOES: NURAAU3 NURAAU0
HSKEEP ;EXPLAIN WHAT TO DO WITH THIS ROUTINE
S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
S IOP=ION D ^%ZIS K IOP
F NURSJ=1:1:2 W !,$$REPEAT^XLFSTR("*",80)
F NURSJ=1:1:2 W !,$C(7),"*****",?$X+70,"*****"
W !,"*****",?$X+19,"** WARNING -- SPECIAL RUNNING **",?$X+19,"*****"
W !,$C(7),"*****",?$X+70,"*****"
W !,"*****",?$X+11,"THE PURPOSE OF THIS OPTION IS TO UPDATE THE NURSING",?$X+8,"*****"
W !,"*****",?$X+11,"PACKAGE ACUITY-EMPLOYEE ACTIVATION/SEPARATION COUNTS ",?$X+6,"*****"
W !,"*****",?$X+11,"THIS ROUTINE SHOULD BE RUN IF TASKMAN IS INOPERABLE",?$X+8,"*****"
W !,$C(7),"*****",?$X+70,"*****"
W !,"*****",?$X+11,"CONTACT THE NURSING ADP COORDINATOR TO CONFIRM THAT THE",?$X+4,"*****"
W !,"*****",?$X+11,"ACUITY (AMIS 1106) UPDATE WILL BE RUN TONIGHT VIA",?$X+10,"*****"
W !,"*****",?$X+11,"TASKMAN.",?$X+51,"*****"
F NURSJ=1:1:2 W !,$C(7),"*****",?$X+70,"*****"
F NURSJ=1:1:2 W !,$$REPEAT^XLFSTR("*",80)
HSKEEP1 ;SET ACUITY RUN SWITCH, AND RUN NURAAU0
R !!,"Press RETURN to continue, or ""^"" to exit: ",X:DTIME
G:X=U!'$T KILLVAR
G:X'="" HSKEEP1
START U IO W @IOF,!!,"... BACKUP/NURSING ACUITY - EMPLOYEE SEP/ACT RUN" D EN1^NURAAU0
KILLVAR ;KILL LOCAL VARIABLES
K NX,YSTRDAY,LASTRUN,D,DO,DI,DQ,NDAT,NDATE,NURI,X,NURSI,NURSJ,NURASTER,DATENODE,NURQUEUE
Q
DOMRECNT ;
D ^NURSAPCH Q:NURSX["LEAVE"!(NURSX["AWOL")!(NURSX["OTH, FAC.")
S:'$D(NCWARD) NCWARD=WARD S BEDSECT=NBEDSECT,CLASS=1
Q:NCWARD="" I $L(BEDSECT)=1 S BEDSECT="0"_BEDSECT
S NCWARD=NWARD F I=1:1:5 S NCLASS(I)=0
S NCLASS(CLASS)=1
I $P($G(^NURSF(211.4,NCWARD,1)),U)="A" D FINALLY^NURAAU0
Q
EN2 ; PRINT PATIENT NOT CLASSIFIED REPORT FROM OPTIONS NURAAM-UNC/NURAAM-MD-UNC
S %DT("B")="T-1",%DT("A")="Select date of "_$S(NURTYPE=0:"AMIS 1106",1:"MIDNIGHT ACUITY")_" Exception report: ",%DT="AXE",%DT(0)="-"_(DT-1) D ^%DT K %DT G:+Y'>0 KILL
S X=+Y,DIC(0)="",DIC="^NURSA(213.5,",DIC("S")="I $P(^(0),U,2)=NURTYPE" D ^DIC K DIC G:+Y'>0 KILL
S DA=+Y,Y=+$P(Y,U,2) D D^DIQ S NURSDATE=Y,(NUROUT,NURSW1,NURPAGE,NURMDSW)=0 D EN9^NURSAGSP I NURMDSW W ! S DIC(0)="AEQMZ" D EN8^NURSAGSP G KILL:$G(NUROUT)
W ! S ZTRTN="START2^NURAAU2" D EN7^NURSUT0 G:POP!($D(ZTSK)) KILL
START2 K ^TMP($J) D SORT,PRINT
;******** THESE TEMPLATES ARE NO LONGER NEEDED [NURA-S-EXCEPTION],[NURA-P-EXCEPTION],[NURA-H-EXCEPTION],[NURA-H-MDEXCEPTION] *********
KILL ;
K ^TMP($J),NPWARD,NDATA,NURMDSW,NURPARM,NUREASON,NURABSNC,NBEDSECT,DFN,DA,D1,%DT,BEDSECT,CLASS,VA,XXX,VAERR,NURSZSP,NURSZAP,NURSZDA,NURQUEUE,NURPLSW,NURPAGE,NPWARD,NURFAC,VAIN,VADM,ZTSAVE,Y,DIC,NURSDATE,DATENODE,NURTYPE,ZSTAVE,ZTRTN,VADM
D ^%ZISC
Q
EN3 ; ENTRY FROM OPTION NURAAM-UNCBAT QUEUED AMIS UNCLASSIFIED REPORT AND
; OPTION NURAAM-MD-UNCBAT QUEUED MIDNIGHT ACUITY UNCLASSIFIED REPORT
S X="T-1",%DT="" D ^%DT G KILL:+Y'>0
S X=+Y,DIC(0)="",DIC="^NURSA(213.5,",DIC("S")="I $P(^(0),U,2)=NURTYPE" D ^DIC K DIC G:+Y'>0 KILL
S DA=+Y,Y=+$P(Y,U,2) D D^DIQ S NURSDATE=Y,(NURMDSW,NURPLSW,NUROUT,NURSW1,NURPAGE)=0 D EN9^NURSAGSP I NURMDSW S NURFAC=1
S ZTRTN="START1^NURAAU2",ZTDESC=$S(NURTYPE=0:"AMIS UNCLASSIFIED REPORT",1:"MIDNIGHT ACUITY UNCLASSIFIED REPORT")
I $G(ZTQUEUED) S ZTSAVE("N*")="",ZTSAVE("DA")="" D ^%ZTLOAD Q ;job is scheduled in File 19.2
W ! D EN7^NURSUT0 G:POP!($D(ZTSK)) KILL
START1 K ^TMP($J) D SORT,PRINT
;******** THESE TEMPLATES ARE NO LONGER NEEDED [NURA-S-EXCEPTION],[NURA-P-EXCEPTION],[NURA-H-MDEXCEPTION],[NURA-H-EXCEPTION] *********
G KILL
SORT ;
S D1=0 F S D1=$O(^NURSA(213.5,DA,1,D1)) Q:D1'>0 D
. S NDATA=^NURSA(213.5,DA,1,D1,0),DFN=+$G(NDATA),NPWARD=$P($G(NDATA),U,2),NURFAC(2)=$S($$EN12^NURSUT3(NPWARD)'="":$$EN12^NURSUT3(NPWARD),1:" BLANK")
. D EN6^NURSAUTL Q:NPWARD=""
. I NURMDSW,$G(NURFAC)=0,NURFAC(2)'=NURFAC(1) Q
. W:$E(IOST)="C"&($R(50)) "." S ^TMP($J,NURFAC(2),NPWARD,DFN,DA,D1)=""
. Q
Q
PRINT ;
Q:$G(IO)="" U IO
I '$D(^TMP($J)) S NURFAC="" D HEADER W !!,"THERE IS NO DATA FOR THIS REPORT" Q
S NURFAC="" F S NURFAC=$O(^TMP($J,NURFAC)) Q:NURFAC=""!(NUROUT) D HEADER Q:NUROUT S NPWARD="" F S NPWARD=$O(^TMP($J,NURFAC,NPWARD)) Q:NPWARD=""!(NUROUT) D HEADER1 S DFN="" F S DFN=$O(^TMP($J,NURFAC,NPWARD,DFN)) Q:DFN=""!(NUROUT) D
.S DA=0 F S DA=$O(^TMP($J,NURFAC,NPWARD,DFN,DA)) Q:DA'>0 S D1=0 F S D1=$O(^TMP($J,NURFAC,NPWARD,DFN,DA,D1)) Q:D1'>0!(NUROUT) D
..I ($Y>(IOSL-4)) D HEADER Q:NUROUT D HEADER1
..W ! D OERR^VADPT W ?1,$E(VADM(1),1,20)_" -"_$P($G(VADM(2)),"-",3)
..S Y=$P($G(^NURSA(213.5,DA,1,D1,0)),U,3) W ?31,$$REASON^NURAAU2(Y) S Z=$P($G(^NURSA(213.5,DA,1,D1,0)),U,4) W ?53,$$ABSENCE^NURAAU2(Z) S Y=$P($G(^(0)),U,5) D D^DIQ W ?62,$E(Y,1,18)
..Q
..S Z=$P($G(^NURSA(213.5,DA,1,D1,0)),U,3) S X=$P($G(^(0)),U,5) D D^DIQ W ?62,$E(Y,1,18)
.Q
Q
I NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:NUROUT
S NURPAGE=NURPAGE+1
W @IOF I NURMDSW W !,?$$CNTR^NURSUT2(NURFAC),$S($G(NURFAC)=" BLANK":"NO FACILITY",1:$G(NURFAC))
W !,$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?14,"UNCLASSIFIED "_$S(NURTYPE=0:"AMIS 1106 ",1:"MIDNIGHT ")_"PATIENTS FOR "_NURSDATE,?71,"PAGE: ",NURPAGE
W !!,?65,"LAST",!,"PATIENT NAME -SSN LAST FOUR",?33,"ERROR",?51,"ABSENCE",?62,"CLASSIFIED",!,$$REPEAT^XLFSTR("-",80)
S NURSW1=1
Q
Q
REASON(NURPARM) ; REASON FOR PATIENT NOT BEING INCLUDED IN AMIS COUNT
S NUREASON=""
S NUREASON=$S(NURPARM=1:"NO WARD ASSIGNED",NURPARM=2:"NOT CLASSIFIED",NURPARM=3:"CLASS. NOT CURRENT",NURPARM=4:"NOT CLASS. BY 3PM",NURPARM=5:"BAD CLASS. XREF",NURPARM=6:"NO CLASS./NEW WARD",NURPARM=7:"BAD DATA",NURPARM=8:"NOT ADMITTED",1:"")
Q NUREASON
ABSENCE(NURPARM) ; PATIENT ABSENCE CODES
S NURABSNC="",NURABSNC=$S(NURPARM=1:"N/A",NURPARM=2:"LEAVE",NURPARM=3:"AWOL",NURPARM=4:"OTH. FAC",NURPARM=5:"ERROR",1:"")
Q NURABSNC
NURAAU2 ;HIRMFO/RM/MD-BACKUP IF NURAAU0 NOT RUN...AMIS 1106a ;6/5/97
+1 ;;4.0;NURSING SERVICE;**1,2,7,20,24,29**;Apr 25, 1997
+2 ; DONE BY: AS REQUIRED DOES: NURAAU3 NURAAU0
HSKEEP ;EXPLAIN WHAT TO DO WITH THIS ROUTINE
+1 SET X=$GET(^DIC(213.9,1,"OFF"))
IF X=""!(X=1)
QUIT
+2 SET IOP=ION
DO ^%ZIS
KILL IOP
+3 FOR NURSJ=1:1:2
WRITE !,$$REPEAT^XLFSTR("*",80)
+4 FOR NURSJ=1:1:2
WRITE !,$CHAR(7),"*****",?$X+70,"*****"
+5 WRITE !,"*****",?$X+19,"** WARNING -- SPECIAL RUNNING **",?$X+19,"*****"
+6 WRITE !,$CHAR(7),"*****",?$X+70,"*****"
+7 WRITE !,"*****",?$X+11,"THE PURPOSE OF THIS OPTION IS TO UPDATE THE NURSING",?$X+8,"*****"
+8 WRITE !,"*****",?$X+11,"PACKAGE ACUITY-EMPLOYEE ACTIVATION/SEPARATION COUNTS ",?$X+6,"*****"
+9 WRITE !,"*****",?$X+11,"THIS ROUTINE SHOULD BE RUN IF TASKMAN IS INOPERABLE",?$X+8,"*****"
+10 WRITE !,$CHAR(7),"*****",?$X+70,"*****"
+11 WRITE !,"*****",?$X+11,"CONTACT THE NURSING ADP COORDINATOR TO CONFIRM THAT THE",?$X+4,"*****"
+12 WRITE !,"*****",?$X+11,"ACUITY (AMIS 1106) UPDATE WILL BE RUN TONIGHT VIA",?$X+10,"*****"
+13 WRITE !,"*****",?$X+11,"TASKMAN.",?$X+51,"*****"
+14 FOR NURSJ=1:1:2
WRITE !,$CHAR(7),"*****",?$X+70,"*****"
+15 FOR NURSJ=1:1:2
WRITE !,$$REPEAT^XLFSTR("*",80)
HSKEEP1 ;SET ACUITY RUN SWITCH, AND RUN NURAAU0
+1 READ !!,"Press RETURN to continue, or ""^"" to exit: ",X:DTIME
+2 IF X=U!'$TEST
GOTO KILLVAR
+3 IF X'=""
GOTO HSKEEP1
START USE IO
WRITE @IOF,!!,"... BACKUP/NURSING ACUITY - EMPLOYEE SEP/ACT RUN"
DO EN1^NURAAU0
KILLVAR ;KILL LOCAL VARIABLES
+1 KILL NX,YSTRDAY,LASTRUN,D,DO,DI,DQ,NDAT,NDATE,NURI,X,NURSI,NURSJ,NURASTER,DATENODE,NURQUEUE
+2 QUIT
DOMRECNT ;
+1 DO ^NURSAPCH
IF NURSX["LEAVE"!(NURSX["AWOL")!(NURSX["OTH, FAC.")
QUIT
+2 IF '$DATA(NCWARD)
SET NCWARD=WARD
SET BEDSECT=NBEDSECT
SET CLASS=1
+3 IF NCWARD=""
QUIT
IF $LENGTH(BEDSECT)=1
SET BEDSECT="0"_BEDSECT
+4 SET NCWARD=NWARD
FOR I=1:1:5
SET NCLASS(I)=0
+5 SET NCLASS(CLASS)=1
+6 IF $PIECE($GET(^NURSF(211.4,NCWARD,1)),U)="A"
DO FINALLY^NURAAU0
+7 QUIT
EN2 ; PRINT PATIENT NOT CLASSIFIED REPORT FROM OPTIONS NURAAM-UNC/NURAAM-MD-UNC
+1 SET %DT("B")="T-1"
SET %DT("A")="Select date of "_$SELECT(NURTYPE=0:"AMIS 1106",1:"MIDNIGHT ACUITY")_" Exception report: "
SET %DT="AXE"
SET %DT(0)="-"_(DT-1)
DO ^%DT
KILL %DT
IF +Y'>0
GOTO KILL
+2 SET X=+Y
SET DIC(0)=""
SET DIC="^NURSA(213.5,"
SET DIC("S")="I $P(^(0),U,2)=NURTYPE"
DO ^DIC
KILL DIC
IF +Y'>0
GOTO KILL
+3 SET DA=+Y
SET Y=+$PIECE(Y,U,2)
DO D^DIQ
SET NURSDATE=Y
SET (NUROUT,NURSW1,NURPAGE,NURMDSW)=0
DO EN9^NURSAGSP
IF NURMDSW
WRITE !
SET DIC(0)="AEQMZ"
DO EN8^NURSAGSP
IF $GET(NUROUT)
GOTO KILL
+4 WRITE !
SET ZTRTN="START2^NURAAU2"
DO EN7^NURSUT0
IF POP!($DATA(ZTSK))
GOTO KILL
START2 KILL ^TMP($JOB)
DO SORT
DO PRINT
+1 ;******** THESE TEMPLATES ARE NO LONGER NEEDED [NURA-S-EXCEPTION],[NURA-P-EXCEPTION],[NURA-H-EXCEPTION],[NURA-H-MDEXCEPTION] *********
KILL ;
+1 KILL ^TMP($JOB),NPWARD,NDATA,NURMDSW,NURPARM,NUREASON,NURABSNC,NBEDSECT,DFN,DA,D1,%DT,BEDSECT,CLASS,VA,XXX,VAERR,NURSZSP,NURSZAP,NURSZDA,NURQUEUE,NURPLSW,NURPAGE,NPWARD,NURFAC,VAIN,VADM,ZTSAVE,Y,DIC,NURSDATE,DATENODE,NURTYPE,ZSTAVE,ZTRTN,VADM
+2 DO ^%ZISC
+3 QUIT
EN3 ; ENTRY FROM OPTION NURAAM-UNCBAT QUEUED AMIS UNCLASSIFIED REPORT AND
+1 ; OPTION NURAAM-MD-UNCBAT QUEUED MIDNIGHT ACUITY UNCLASSIFIED REPORT
+2 SET X="T-1"
SET %DT=""
DO ^%DT
IF +Y'>0
GOTO KILL
+3 SET X=+Y
SET DIC(0)=""
SET DIC="^NURSA(213.5,"
SET DIC("S")="I $P(^(0),U,2)=NURTYPE"
DO ^DIC
KILL DIC
IF +Y'>0
GOTO KILL
+4 SET DA=+Y
SET Y=+$PIECE(Y,U,2)
DO D^DIQ
SET NURSDATE=Y
SET (NURMDSW,NURPLSW,NUROUT,NURSW1,NURPAGE)=0
DO EN9^NURSAGSP
IF NURMDSW
SET NURFAC=1
+5 SET ZTRTN="START1^NURAAU2"
SET ZTDESC=$SELECT(NURTYPE=0:"AMIS UNCLASSIFIED REPORT",1:"MIDNIGHT ACUITY UNCLASSIFIED REPORT")
+6 ;job is scheduled in File 19.2
IF $GET(ZTQUEUED)
SET ZTSAVE("N*")=""
SET ZTSAVE("DA")=""
DO ^%ZTLOAD
QUIT
+7 WRITE !
DO EN7^NURSUT0
IF POP!($DATA(ZTSK))
GOTO KILL
START1 KILL ^TMP($JOB)
DO SORT
DO PRINT
+1 ;******** THESE TEMPLATES ARE NO LONGER NEEDED [NURA-S-EXCEPTION],[NURA-P-EXCEPTION],[NURA-H-MDEXCEPTION],[NURA-H-EXCEPTION] *********
+2 GOTO KILL
SORT ;
+1 SET D1=0
FOR
SET D1=$ORDER(^NURSA(213.5,DA,1,D1))
IF D1'>0
QUIT
Begin DoDot:1
+2 SET NDATA=^NURSA(213.5,DA,1,D1,0)
SET DFN=+$GET(NDATA)
SET NPWARD=$PIECE($GET(NDATA),U,2)
SET NURFAC(2)=$SELECT($$EN12^NURSUT3(NPWARD)'="":$$EN12^NURSUT3(NPWARD),1:" BLANK")
+3 DO EN6^NURSAUTL
IF NPWARD=""
QUIT
+4 IF NURMDSW
IF $GET(NURFAC)=0
IF NURFAC(2)'=NURFAC(1)
QUIT
+5 IF $EXTRACT(IOST)="C"&($RANDOM(50))
WRITE "."
SET ^TMP($JOB,NURFAC(2),NPWARD,DFN,DA,D1)=""
+6 QUIT
End DoDot:1
+7 QUIT
PRINT ;
+1 IF $GET(IO)=""
QUIT
USE IO
+2 IF '$DATA(^TMP($JOB))
SET NURFAC=""
DO HEADER
WRITE !!,"THERE IS NO DATA FOR THIS REPORT"
QUIT
+3 SET NURFAC=""
FOR
SET NURFAC=$ORDER(^TMP($JOB,NURFAC))
IF NURFAC=""!(NUROUT)
QUIT
DO HEADER
IF NUROUT
QUIT
SET NPWARD=""
FOR
SET NPWARD=$ORDER(^TMP($JOB,NURFAC,NPWARD))
IF NPWARD=""!(NUROUT)
QUIT
DO HEADER1
SET DFN=""
FOR
SET DFN=$ORDER(^TMP($JOB,NURFAC,NPWARD,DFN))
IF DFN=""!(NUROUT)
QUIT
Begin DoDot:1
+4 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,NURFAC,NPWARD,DFN,DA))
IF DA'>0
QUIT
SET D1=0
FOR
SET D1=$ORDER(^TMP($JOB,NURFAC,NPWARD,DFN,DA,D1))
IF D1'>0!(NUROUT)
QUIT
Begin DoDot:2
+5 IF ($Y>(IOSL-4))
DO HEADER
IF NUROUT
QUIT
DO HEADER1
+6 WRITE !
DO OERR^VADPT
WRITE ?1,$EXTRACT(VADM(1),1,20)_" -"_$PIECE($GET(VADM(2)),"-",3)
+7 SET Y=$PIECE($GET(^NURSA(213.5,DA,1,D1,0)),U,3)
WRITE ?31,$$REASON^NURAAU2(Y)
SET Z=$PIECE($GET(^NURSA(213.5,DA,1,D1,0)),U,4)
WRITE ?53,$$ABSENCE^NURAAU2(Z)
SET Y=$PIECE($GET(^(0)),U,5)
DO D^DIQ
WRITE ?62,$EXTRACT(Y,1,18)
+8 QUIT
+9 SET Z=$PIECE($GET(^NURSA(213.5,DA,1,D1,0)),U,3)
SET X=$PIECE($GET(^(0)),U,5)
DO D^DIQ
WRITE ?62,$EXTRACT(Y,1,18)
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
+1 IF NURSW1
IF $EXTRACT(IOST)="C"
DO ENDPG^NURSUT1
IF NUROUT
QUIT
+2 SET NURPAGE=NURPAGE+1
+3 WRITE @IOF
IF NURMDSW
WRITE !,?$$CNTR^NURSUT2(NURFAC),$SELECT($GET(NURFAC)=" BLANK":"NO FACILITY",1:$GET(NURFAC))
+4 WRITE !,$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3),?14,"UNCLASSIFIED "_$SELECT(NURTYPE=0:"AMIS 1106 ",1:"MIDNIGHT ")_"PATIENTS FOR "_NURSDATE,?71,"PAGE: ",NURPAGE
+5 WRITE !!,?65,"LAST",!,"PATIENT NAME -SSN LAST FOUR",?33,"ERROR",?51,"ABSENCE",?62,"CLASSIFIED",!,$$REPEAT^XLFSTR("-",80)
+6 SET NURSW1=1
+7 QUIT
+1 QUIT
REASON(NURPARM) ; REASON FOR PATIENT NOT BEING INCLUDED IN AMIS COUNT
+1 SET NUREASON=""
+2 SET NUREASON=$SELECT(NURPARM=1:"NO WARD ASSIGNED",NURPARM=2:"NOT CLASSIFIED",NURPARM=3:"CLASS. NOT CURRENT",NURPARM=4:"NOT CLASS. BY 3PM",NURPARM=5:"BAD CLASS. XREF",NURPARM=6:"NO CLASS./NEW WARD",NURPARM=7:"BAD DATA",NURPARM=8:"NOT ADMITTED",1
:"")
+3 QUIT NUREASON
ABSENCE(NURPARM) ; PATIENT ABSENCE CODES
+1 SET NURABSNC=""
SET NURABSNC=$SELECT(NURPARM=1:"N/A",NURPARM=2:"LEAVE",NURPARM=3:"AWOL",NURPARM=4:"OTH. FAC",NURPARM=5:"ERROR",1:"")
+2 QUIT NURABSNC
