source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURAAU2.m

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
HEADER ;HEAD ROUTINE
 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
HEADER1 W !!,?10,"UNIT:   ",NPWARD,!
 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