- 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 Jan 18, 2025@03:19:53 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