47 lines
3.3 KiB
Mathematica
47 lines
3.3 KiB
Mathematica
NURAAE0 ;HIRMFO/RM,MD,FT-EDIT ACUITY TOTALS...AMIS 1106a ;8/14/96 09:35
|
|
;;4.0;NURSING SERVICE;**16,30**;Apr 25, 1997
|
|
EN1 ; ENTRY FROM MENU OPTION NURAAM-ACUEDT
|
|
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
|
|
S OUTSW=0 D NODESEL I OUTSW G QUIT
|
|
F NURSX=0:0 S NOSW=0 D WARD Q:NOSW!OUTSW D NEXT
|
|
G QUIT:OUTSW,EN1
|
|
Q
|
|
NEXT 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
|
|
Q
|
|
NODESEL ; SELECT NODE TO BE EDITED, THIS IS THE DATE PART
|
|
R !!,"Select DATE that patient was classified: ",X:DTIME
|
|
I "^"[X!('$T) S OUTSW=1 Q
|
|
S %DT="XE" D ^%DT G:((X["?")!(+Y<0)) NODESEL
|
|
S RPTDATE=+Y
|
|
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
|
|
S X1=DT,X2=RPTDATE D ^%DTC I X'>0 W !,$C(7),"SORRY, CANNOT EDIT FUTURE OR PRESENT DATES." S OUTSW=1 Q
|
|
SHIFT ; SELECT SHIFT OF RECORD TO BE EDITED
|
|
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
|
|
I NURSHFT["?" W !,"Enter shift selection(s) (i.e., N,D,E - A - ALL - ND - DE etc)." G SHIFT
|
|
S NURSHFT=$S(NURSHFT?1L:$C($A(NURSHFT)-32),1:NURSHFT)
|
|
I '((NURSHFT="A")!(NURSHFT="ALL")!(NURSHFT="N")!(NURSHFT="D")!(NURSHFT="E"))&($L(NURSHFT)'>1) G MSG
|
|
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
|
|
I NURSHFT="A"!(NURSHFT="ALL") F NURX=1:1:3 S SHIFT(NURX)=$S(NURX=1:"N",NURX=2:"D",1:"E")
|
|
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)
|
|
Q
|
|
WARD ; SELECT WARD OF NODE
|
|
R !,"Select UNIT that needs correction: ",X:DTIME
|
|
S:X="" NOSW=1 S:'$T!(X="^") OUTSW=1 Q:"^"[X!'$T
|
|
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"""
|
|
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"""
|
|
S DIC="^NURSF(211.4,",DIC(0)="QEZ" D ^DIC K DIC G:((X["?")!(+Y<0)) WARD
|
|
S (NPWARD,WARD)=+Y D EN6^NURSAUTL
|
|
BEDSECT ; SELECT BED SECTION OF NODE
|
|
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)
|
|
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
|
|
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)
|
|
Q
|
|
EDIT ; UPDATE ACUITY IN 213.4 amis 10-1106A MANHOURS FILE
|
|
I '$D(^NURSA(213.4,DA(1),1,0)) S ^NURSA(213.4,DA(1),1,0)="^213.41PA^^"
|
|
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 !
|
|
Q
|
|
QUIT ; KILL LOCAL VARIABLES
|
|
D ^NURAKILL
|
|
Q
|
|
MSG W !,$C(7)," ** IMPROPER SHIFT SELECTION **" G SHIFT
|