source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAAE0.m@ 767

Last change on this file since 767 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1NURAAE0 ;HIRMFO/RM,MD,FT-EDIT ACUITY TOTALS...AMIS 1106a ;8/14/96 09:35
2 ;;4.0;NURSING SERVICE;**16,30**;Apr 25, 1997
3EN1 ; ENTRY FROM MENU OPTION NURAAM-ACUEDT
4 Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
5 S OUTSW=0 D NODESEL I OUTSW G QUIT
6 F NURSX=0:0 S NOSW=0 D WARD Q:NOSW!OUTSW D NEXT
7 G QUIT:OUTSW,EN1
8 Q
9NEXT F I=0:0 S I=$O(SHIFT(I)) Q:I="" W !!,"...Editing "_$S(SHIFT(I)="E":"Evening",SHIFT(I)="D":"Day",SHIFT(I)="N":"Night",1:"")_" SHIFT for ward "_NPWARD_"..." S NURSHFT=SHIFT(I) D EN1^NURAAE1 Q:OUTSW D:'NOSW EDIT
10 Q
11NODESEL ; SELECT NODE TO BE EDITED, THIS IS THE DATE PART
12 R !!,"Select DATE that patient was classified: ",X:DTIME
13 I "^"[X!('$T) S OUTSW=1 Q
14 S %DT="XE" D ^%DT G:((X["?")!(+Y<0)) NODESEL
15 S RPTDATE=+Y
16 S X="T-120",%DT="" D ^%DT S (X1,MNCHKDTE)=Y,X2=RPTDATE D ^%DTC I X>0 W $C(7),!,"THIS DATE IS TOO FAR IN THE PAST. CANNOT UPDATE OR EDIT." S OUTSW=1 Q
17 S X1=DT,X2=RPTDATE D ^%DTC I X'>0 W !,$C(7),"SORRY, CANNOT EDIT FUTURE OR PRESENT DATES." S OUTSW=1 Q
18SHIFT ; SELECT SHIFT OF RECORD TO BE EDITED
19 R !!,"Select Shift(s) (Enter [N]ight [D]AY [E]vening or [A]ll Shifts): ",NURSHFT:DTIME,! I "^"[NURSHFT!('$T)!(NURSHFT="") S OUTSW=1 Q
20 I NURSHFT["?" W !,"Enter shift selection(s) (i.e., N,D,E - A - ALL - ND - DE etc)." G SHIFT
21 S NURSHFT=$S(NURSHFT?1L:$C($A(NURSHFT)-32),1:NURSHFT)
22 I '((NURSHFT="A")!(NURSHFT="ALL")!(NURSHFT="N")!(NURSHFT="D")!(NURSHFT="E"))&($L(NURSHFT)'>1) G MSG
23 I $L(NURSHFT)>1 F I=1:1:5 I $E(NURSHFT,I)'=","&($E(NURSHFT,I)'="D")&($E(NURSHFT,I)'="N")&($E(NURSHFT,I)'="E")&($E(NURSHFT,I)'="") G MSG
24 I NURSHFT="A"!(NURSHFT="ALL") F NURX=1:1:3 S SHIFT(NURX)=$S(NURX=1:"N",NURX=2:"D",1:"E")
25 E K SHIFT F NURX=1:1:$L(NURSHFT) S:$E(NURSHFT,NURX)'="," SHIFT($S($E(NURSHFT,NURX)="N":1,$E(NURSHFT,NURX)="D":2,$E(NURSHFT,NURX)="E":3,1:0))=$E(NURSHFT,NURX)
26 Q
27WARD ; SELECT WARD OF NODE
28 R !,"Select UNIT that needs correction: ",X:DTIME
29 S:X="" NOSW=1 S:'$T!(X="^") OUTSW=1 Q:"^"[X!'$T
30 I DUZ(0)'["n",DUZ(0)'["@" S DIC("S")="I $P($G(^SC(+$G(^NURSF(211.4,+Y,0)),0)),U)'[""MAS ONLY"",$P($G(^SC(+$G(^NURSF(211.4,+Y,0)),0)),U)'[""MASONLY"",$P($G(^NURSF(211.4,+Y,""I"")),U)'=""I"""
31 E S DIC("S")="I $P($G(^SC(+$G(^NURSF(211.4,+Y,0)),0)),U)'[""MAS ONLY"",$P($G(^SC(+$G(^NURSF(211.4,+Y,0)),0)),U)'[""MASONLY"""
32 S DIC="^NURSF(211.4,",DIC(0)="QEZ" D ^DIC K DIC G:((X["?")!(+Y<0)) WARD
33 S (NPWARD,WARD)=+Y D EN6^NURSAUTL
34BEDSECT ; SELECT BED SECTION OF NODE
35 S D1=$O(^NURSF(211.4,WARD,4,0)),X=+$G(^NURSF(211.4,WARD,4,+D1,0)) I '($P($G(^NURSF(213.3,+X,0)),U)="") S DIC("B")=$P($G(^NURSF(213.3,+X,0)),U)
36 S DIC="^NURSF(213.3,",DIC(0)="AEMZQ",DIC("A")="Select NURSING BED SECTION that needs correction: " W ! D ^DIC S:X="" NOSW=1 I ((U[X)!'(+Y>0)) S OUTSW=1 Q
37 S BEDSECT=$P(Y,"^"),NUREND=$S($P(^NURSF(213.3,+BEDSECT,1),U)="DOM"!($P(^(1),U)="REC"):1,$P(^(1),U)="NHC":3,$P(^(1),U)="ICU":3,$P(^(1),U)="INT":3,$P(^(1),U)="SCI":5,1:4)
38 Q
39EDIT ; UPDATE ACUITY IN 213.4 amis 10-1106A MANHOURS FILE
40 I '$D(^NURSA(213.4,DA(1),1,0)) S ^NURSA(213.4,DA(1),1,0)="^213.41PA^^"
41 S DA=$O(^NURSA(213.4,DA(1),1,"B",BEDSECT,0)) Q:DA'>0 W ! S DIE="^NURSA(213.4,DA(1),1,",DR="1//;S:NUREND=1 Y=""@10"";Q;2//;3//;S:NUREND=3 Y=""@10"";Q;4//;S:NUREND=4 Y=""@10"";Q;5//;@10;" D ^DIE K DIE W !
42 Q
43QUIT ; KILL LOCAL VARIABLES
44 D ^NURAKILL
45 Q
46MSG W !,$C(7)," ** IMPROPER SHIFT SELECTION **" G SHIFT
Note: See TracBrowser for help on using the repository browser.