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

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1NURAAU2 ;HIRMFO/RM/MD-BACKUP IF NURAAU0 NOT RUN...AMIS 1106a ;6/5/97
2 ;;4.0;NURSING SERVICE;**1,2,7,20,24,29**;Apr 25, 1997
3 ; DONE BY: AS REQUIRED DOES: NURAAU3 NURAAU0
4HSKEEP ;EXPLAIN WHAT TO DO WITH THIS ROUTINE
5 S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
6 S IOP=ION D ^%ZIS K IOP
7 F NURSJ=1:1:2 W !,$$REPEAT^XLFSTR("*",80)
8 F NURSJ=1:1:2 W !,$C(7),"*****",?$X+70,"*****"
9 W !,"*****",?$X+19,"** WARNING -- SPECIAL RUNNING **",?$X+19,"*****"
10 W !,$C(7),"*****",?$X+70,"*****"
11 W !,"*****",?$X+11,"THE PURPOSE OF THIS OPTION IS TO UPDATE THE NURSING",?$X+8,"*****"
12 W !,"*****",?$X+11,"PACKAGE ACUITY-EMPLOYEE ACTIVATION/SEPARATION COUNTS ",?$X+6,"*****"
13 W !,"*****",?$X+11,"THIS ROUTINE SHOULD BE RUN IF TASKMAN IS INOPERABLE",?$X+8,"*****"
14 W !,$C(7),"*****",?$X+70,"*****"
15 W !,"*****",?$X+11,"CONTACT THE NURSING ADP COORDINATOR TO CONFIRM THAT THE",?$X+4,"*****"
16 W !,"*****",?$X+11,"ACUITY (AMIS 1106) UPDATE WILL BE RUN TONIGHT VIA",?$X+10,"*****"
17 W !,"*****",?$X+11,"TASKMAN.",?$X+51,"*****"
18 F NURSJ=1:1:2 W !,$C(7),"*****",?$X+70,"*****"
19 F NURSJ=1:1:2 W !,$$REPEAT^XLFSTR("*",80)
20HSKEEP1 ;SET ACUITY RUN SWITCH, AND RUN NURAAU0
21 R !!,"Press RETURN to continue, or ""^"" to exit: ",X:DTIME
22 G:X=U!'$T KILLVAR
23 G:X'="" HSKEEP1
24START U IO W @IOF,!!,"... BACKUP/NURSING ACUITY - EMPLOYEE SEP/ACT RUN" D EN1^NURAAU0
25KILLVAR ;KILL LOCAL VARIABLES
26 K NX,YSTRDAY,LASTRUN,D,DO,DI,DQ,NDAT,NDATE,NURI,X,NURSI,NURSJ,NURASTER,DATENODE,NURQUEUE
27 Q
28DOMRECNT ;
29 D ^NURSAPCH Q:NURSX["LEAVE"!(NURSX["AWOL")!(NURSX["OTH, FAC.")
30 S:'$D(NCWARD) NCWARD=WARD S BEDSECT=NBEDSECT,CLASS=1
31 Q:NCWARD="" I $L(BEDSECT)=1 S BEDSECT="0"_BEDSECT
32 S NCWARD=NWARD F I=1:1:5 S NCLASS(I)=0
33 S NCLASS(CLASS)=1
34 I $P($G(^NURSF(211.4,NCWARD,1)),U)="A" D FINALLY^NURAAU0
35 Q
36EN2 ; PRINT PATIENT NOT CLASSIFIED REPORT FROM OPTIONS NURAAM-UNC/NURAAM-MD-UNC
37 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
38 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
39 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)
40 W ! S ZTRTN="START2^NURAAU2" D EN7^NURSUT0 G:POP!($D(ZTSK)) KILL
41START2 K ^TMP($J) D SORT,PRINT
42 ;******** THESE TEMPLATES ARE NO LONGER NEEDED [NURA-S-EXCEPTION],[NURA-P-EXCEPTION],[NURA-H-EXCEPTION],[NURA-H-MDEXCEPTION] *********
43KILL ;
44 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
45 D ^%ZISC
46 Q
47EN3 ; ENTRY FROM OPTION NURAAM-UNCBAT QUEUED AMIS UNCLASSIFIED REPORT AND
48 ; OPTION NURAAM-MD-UNCBAT QUEUED MIDNIGHT ACUITY UNCLASSIFIED REPORT
49 S X="T-1",%DT="" D ^%DT G KILL:+Y'>0
50 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
51 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
52 S ZTRTN="START1^NURAAU2",ZTDESC=$S(NURTYPE=0:"AMIS UNCLASSIFIED REPORT",1:"MIDNIGHT ACUITY UNCLASSIFIED REPORT")
53 I $G(ZTQUEUED) S ZTSAVE("N*")="",ZTSAVE("DA")="" D ^%ZTLOAD Q ;job is scheduled in File 19.2
54 W ! D EN7^NURSUT0 G:POP!($D(ZTSK)) KILL
55START1 K ^TMP($J) D SORT,PRINT
56 ;******** THESE TEMPLATES ARE NO LONGER NEEDED [NURA-S-EXCEPTION],[NURA-P-EXCEPTION],[NURA-H-MDEXCEPTION],[NURA-H-EXCEPTION] *********
57 G KILL
58SORT ;
59 S D1=0 F S D1=$O(^NURSA(213.5,DA,1,D1)) Q:D1'>0 D
60 . 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")
61 . D EN6^NURSAUTL Q:NPWARD=""
62 . I NURMDSW,$G(NURFAC)=0,NURFAC(2)'=NURFAC(1) Q
63 . W:$E(IOST)="C"&($R(50)) "." S ^TMP($J,NURFAC(2),NPWARD,DFN,DA,D1)=""
64 . Q
65 Q
66PRINT ;
67 Q:$G(IO)="" U IO
68 I '$D(^TMP($J)) S NURFAC="" D HEADER W !!,"THERE IS NO DATA FOR THIS REPORT" Q
69 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
70 .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
71 ..I ($Y>(IOSL-4)) D HEADER Q:NUROUT D HEADER1
72 ..W ! D OERR^VADPT W ?1,$E(VADM(1),1,20)_" -"_$P($G(VADM(2)),"-",3)
73 ..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)
74 ..Q
75 ..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)
76 .Q
77 Q
78HEADER ;HEAD ROUTINE
79 I NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:NUROUT
80 S NURPAGE=NURPAGE+1
81 W @IOF I NURMDSW W !,?$$CNTR^NURSUT2(NURFAC),$S($G(NURFAC)=" BLANK":"NO FACILITY",1:$G(NURFAC))
82 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
83 W !!,?65,"LAST",!,"PATIENT NAME -SSN LAST FOUR",?33,"ERROR",?51,"ABSENCE",?62,"CLASSIFIED",!,$$REPEAT^XLFSTR("-",80)
84 S NURSW1=1
85 Q
86HEADER1 W !!,?10,"UNIT: ",NPWARD,!
87 Q
88REASON(NURPARM) ; REASON FOR PATIENT NOT BEING INCLUDED IN AMIS COUNT
89 S NUREASON=""
90 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:"")
91 Q NUREASON
92ABSENCE(NURPARM) ; PATIENT ABSENCE CODES
93 S NURABSNC="",NURABSNC=$S(NURPARM=1:"N/A",NURPARM=2:"LEAVE",NURPARM=3:"AWOL",NURPARM=4:"OTH. FAC",NURPARM=5:"ERROR",1:"")
94 Q NURABSNC
Note: See TracBrowser for help on using the repository browser.