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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAAE0 3374 printed Dec 13, 2024@02:18:43 Page 2
NURAAE0 ;HIRMFO/RM,MD,FT-EDIT ACUITY TOTALS...AMIS 1106a ;8/14/96 09:35
+1 ;;4.0;NURSING SERVICE;**16,30**;Apr 25, 1997
EN1 ; ENTRY FROM MENU OPTION NURAAM-ACUEDT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 SET OUTSW=0
DO NODESEL
IF OUTSW
GOTO QUIT
+3 FOR NURSX=0:0
SET NOSW=0
DO WARD
if NOSW!OUTSW
QUIT
DO NEXT
+4 if OUTSW
GOTO QUIT
GOTO EN1
+5 QUIT
NEXT FOR I=0:0
SET I=$ORDER(SHIFT(I))
if I=""
QUIT
WRITE !!,"...Editing "_$SELECT(SHIFT(I)="E":"Evening",SHIFT(I)="D":"Day",SHIFT(I)="N":"Night",1:"")_" SHIFT for ward "_NPWARD_"..."
SET NURSHFT=SHIFT(I)
DO EN1^NURAAE1
if OUTSW
QUIT
if 'NOSW
DO EDIT
+1 QUIT
NODESEL ; SELECT NODE TO BE EDITED, THIS IS THE DATE PART
+1 READ !!,"Select DATE that patient was classified: ",X:DTIME
+2 IF "^"[X!('$TEST)
SET OUTSW=1
QUIT
+3 SET %DT="XE"
DO ^%DT
if ((X["?")!(+Y<0))
GOTO NODESEL
+4 SET RPTDATE=+Y
+5 SET X="T-120"
SET %DT=""
DO ^%DT
SET (X1,MNCHKDTE)=Y
SET X2=RPTDATE
DO ^%DTC
IF X>0
WRITE $CHAR(7),!,"THIS DATE IS TOO FAR IN THE PAST. CANNOT UPDATE OR EDIT."
SET OUTSW=1
QUIT
+6 SET X1=DT
SET X2=RPTDATE
DO ^%DTC
IF X'>0
WRITE !,$CHAR(7),"SORRY, CANNOT EDIT FUTURE OR PRESENT DATES."
SET OUTSW=1
QUIT
SHIFT ; SELECT SHIFT OF RECORD TO BE EDITED
+1 READ !!,"Select Shift(s) (Enter [N]ight [D]AY [E]vening or [A]ll Shifts): ",NURSHFT:DTIME,!
IF "^"[NURSHFT!('$TEST)!(NURSHFT="")
SET OUTSW=1
QUIT
+2 IF NURSHFT["?"
WRITE !,"Enter shift selection(s) (i.e., N,D,E - A - ALL - ND - DE etc)."
GOTO SHIFT
+3 SET NURSHFT=$SELECT(NURSHFT?1L:$CHAR($ASCII(NURSHFT)-32),1:NURSHFT)
+4 IF '((NURSHFT="A")!(NURSHFT="ALL")!(NURSHFT="N")!(NURSHFT="D")!(NURSHFT="E"))&($LENGTH(NURSHFT)'>1)
GOTO MSG
+5 IF $LENGTH(NURSHFT)>1
FOR I=1:1:5
IF $EXTRACT(NURSHFT,I)'=","&($EXTRACT(NURSHFT,I)'="D")&($EXTRACT(NURSHFT,I)'="N")&($EXTRACT(NURSHFT,I)'="E")&($EXTRACT(NURSHFT,I)'="")
GOTO MSG
+6 IF NURSHFT="A"!(NURSHFT="ALL")
FOR NURX=1:1:3
SET SHIFT(NURX)=$SELECT(NURX=1:"N",NURX=2:"D",1:"E")
+7 IF '$TEST
KILL SHIFT
FOR NURX=1:1:$LENGTH(NURSHFT)
if $EXTRACT(NURSHFT,NURX)'=","
SET SHIFT($SELECT($EXTRACT(NURSHFT,NURX)="N":1,$EXTRACT(NURSHFT,NURX)="D":2,$EXTRACT(NURSHFT,NURX)="E":3,1:0))=$EXTRACT(NURSHFT,NURX)
+8 QUIT
WARD ; SELECT WARD OF NODE
+1 READ !,"Select UNIT that needs correction: ",X:DTIME
+2 if X=""
SET NOSW=1
if '$TEST!(X="^")
SET OUTSW=1
if "^"[X!'$TEST
QUIT
+3 IF DUZ(0)'["n"
IF DUZ(0)'["@"
SET 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"""
+4 IF '$TEST
SET 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"""
+5 SET DIC="^NURSF(211.4,"
SET DIC(0)="QEZ"
DO ^DIC
KILL DIC
if ((X["?")!(+Y<0))
GOTO WARD
+6 SET (NPWARD,WARD)=+Y
DO EN6^NURSAUTL
BEDSECT ; SELECT BED SECTION OF NODE
+1 SET D1=$ORDER(^NURSF(211.4,WARD,4,0))
SET X=+$GET(^NURSF(211.4,WARD,4,+D1,0))
IF '($PIECE($GET(^NURSF(213.3,+X,0)),U)="")
SET DIC("B")=$PIECE($GET(^NURSF(213.3,+X,0)),U)
+2 SET DIC="^NURSF(213.3,"
SET DIC(0)="AEMZQ"
SET DIC("A")="Select NURSING BED SECTION that needs correction: "
WRITE !
DO ^DIC
if X=""
SET NOSW=1
IF ((U[X)!'(+Y>0))
SET OUTSW=1
QUIT
+3 SET BEDSECT=$PIECE(Y,"^")
SET NUREND=$SELECT($PIECE(^NURSF(213.3,+BEDSECT,1),U)="DOM"!($PIECE(^(1),U)="REC"):1,$PIECE(^(1),U)="NHC":3,$PIECE(^(1),U)="ICU":3,$PIECE(^(1),U)="INT":3,$PIECE(^(1),U)="SCI":5,1:4)
+4 QUIT
EDIT ; UPDATE ACUITY IN 213.4 amis 10-1106A MANHOURS FILE
+1 IF '$DATA(^NURSA(213.4,DA(1),1,0))
SET ^NURSA(213.4,DA(1),1,0)="^213.41PA^^"
+2 SET DA=$ORDER(^NURSA(213.4,DA(1),1,"B",BEDSECT,0))
if DA'>0
QUIT
WRITE !
SET DIE="^NURSA(213.4,DA(1),1,"
SET 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;"
DO ^DIE
KILL DIE
WRITE !
+3 QUIT
QUIT ; KILL LOCAL VARIABLES
+1 DO ^NURAKILL
+2 QUIT
MSG WRITE !,$CHAR(7)," ** IMPROPER SHIFT SELECTION **"
GOTO SHIFT
