ANSEAV1 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ACUITY DATA; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;ENTER/EDIT ACUITY DATA CON'T
A1 D HEAD
Q:'$D(^DPT(+$G(ANSDFN),0))
S X=$P(^DPT(ANSDFN,0),U)
W !!,$P(X,","),", ",$P(X,",",2,99)
S X=$P($G(^AUPNPAT(ANSDFN,41,ANSSITE,0)),U,2)
I X]"" W " (",X,")"
D SUBH
S T=0
W !!
D CARH
F I=1:1:5 D SB1
W !!,"Adj. Factors: "
I ANSAF="" W "None Listed"
E F I=1:1 S X=$P(ANSAF,U,I) Q:X="" D A2
S L=$O(^ANSD(51.1,1,"K",T-1))
Q:'$D(^ANSD(51.1,1,"K",+L,0))
S L=$P(^ANSD(51.1,1,"K",L,0),U,2),X=$P(^(0),U,3)
W !!,"Total Weight: "
I T>33 W:IOST["C-" @ANSRVON W " ",T,@ANSSPAC W:IOST["C-" @ANSRVOF
E W:T<34 T
W ?25,"Nursing Care Level: "
I L'["V" W L," - ",X
E W:IOST["C-" @ANSRVON W L," - ",X,@ANSSPAC W:IOST["C-" @ANSRVOF
Q
SB1 W !
S S=I
W S
D AREA
S S=S+5
W ?40,$J(S,2)
D AREA
Q
AREA N X
S X=$G(^ANSD(59,S,0)) W " ",$P(X,U),"(",$P(X,U,2)," levs)"
W ?30
W:$X>40 ?73
S L=$P(ANSCL,U,S)
W L
I L>4,$G(X)]"",$P(X,U,L) S L=$P(X,U,L)
S T=T+L,ANSTOT=T
Q
A2 I $D(^ANSD(59.3,X,0)) S X=$P(^(0),U,2),S=$P(^(0),U,3),L=$L(X) D
.W:$X+L>74 !,?14
.W:I>1 ","
.W:IOST["C-" @ANSRVON
.W @ANSSPAC,X,@ANSSPAC
.W:IOST["C-" @ANSRVOF
.I S]"" S @("T=T"_S_"4")
Q
CARH W ?6,"Care Area",?25,"Current Level",?46,"Care Area",?67,"Current Level"
W !,"-----------------------",?25,"-------------",?40,"-------------------------",?67,"-------------"
Q
HEAD D HEAD^ANSEAV
Q
SUBH S Y=ANSDT
X ^DD("DD")
W !!,?3,Y
S Y="",ANSS=$P(ANSPAR,U,5)
I $D(ANSSH) S X=$T(@ANSS),Y=$P($P(X,";;",ANSSH+1),U,2) W ?22,Y," Shift"
Q:'$D(^ANSD(59.1,+$G(ANSUN),0))
S Z=$P(^ANSD(59.1,ANSUN,0),U)
W ?45,"Unit ",Z
S Y=$P(ANSDX,U,3)
I Y,$D(^ANSD(59.1,ANSUN,"R",Y,0)) D
.W " Rm ",$P(^ANSD(59.1,ANSUN,"R",Y,0),U)
.S Y=$P(ANSDX,U,4)
.I Y,$D(^ANSD(59.1,ANSUN,"R",Y,"B",Y,0)) W "-",$P(^(0),U)
Q
DISP D HEAD,SUBH
W !
Q
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
ANSEAV1 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ACUITY DATA; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;;ENTER/EDIT ACUITY DATA CON'T
A1 DO HEAD
+1 IF '$DATA(^DPT(+$GET(ANSDFN),0))
QUIT
+2 SET X=$PIECE(^DPT(ANSDFN,0),U)
+3 WRITE !!,$PIECE(X,","),", ",$PIECE(X,",",2,99)
+4 SET X=$PIECE($GET(^AUPNPAT(ANSDFN,41,ANSSITE,0)),U,2)
+5 IF X]""
WRITE " (",X,")"
+6 DO SUBH
+7 SET T=0
+8 WRITE !!
+9 DO CARH
+10 FOR I=1:1:5
DO SB1
+11 WRITE !!,"Adj. Factors: "
+12 IF ANSAF=""
WRITE "None Listed"
+13 IF '$TEST
FOR I=1:1
SET X=$PIECE(ANSAF,U,I)
IF X=""
QUIT
DO A2
+14 SET L=$ORDER(^ANSD(51.1,1,"K",T-1))
+15 IF '$DATA(^ANSD(51.1,1,"K",+L,0))
QUIT
+16 SET L=$PIECE(^ANSD(51.1,1,"K",L,0),U,2)
SET X=$PIECE(^(0),U,3)
+17 WRITE !!,"Total Weight: "
+18 IF T>33
IF IOST["C-"
WRITE @ANSRVON
WRITE " ",T,@ANSSPAC
IF IOST["C-"
WRITE @ANSRVOF
+19 IF '$TEST
IF T<34
WRITE T
+20 WRITE ?25,"Nursing Care Level: "
+21 IF L'["V"
WRITE L," - ",X
+22 IF '$TEST
IF IOST["C-"
WRITE @ANSRVON
WRITE L," - ",X,@ANSSPAC
IF IOST["C-"
WRITE @ANSRVOF
+23 QUIT
SB1 WRITE !
+1 SET S=I
+2 WRITE S
+3 DO AREA
+4 SET S=S+5
+5 WRITE ?40,$JUSTIFY(S,2)
+6 DO AREA
+7 QUIT
AREA NEW X
+1 SET X=$GET(^ANSD(59,S,0))
WRITE " ",$PIECE(X,U),"(",$PIECE(X,U,2)," levs)"
+2 WRITE ?30
+3 IF $X>40
WRITE ?73
+4 SET L=$PIECE(ANSCL,U,S)
+5 WRITE L
+6 IF L>4
IF $GET(X)]""
IF $PIECE(X,U,L)
SET L=$PIECE(X,U,L)
+7 SET T=T+L
SET ANSTOT=T
+8 QUIT
A2 IF $DATA(^ANSD(59.3,X,0))
SET X=$PIECE(^(0),U,2)
SET S=$PIECE(^(0),U,3)
SET L=$LENGTH(X)
Begin DoDot:1
+1 IF $X+L>74
WRITE !,?14
+2 IF I>1
WRITE ","
+3 IF IOST["C-"
WRITE @ANSRVON
+4 WRITE @ANSSPAC,X,@ANSSPAC
+5 IF IOST["C-"
WRITE @ANSRVOF
+6 IF S]""
SET @("T=T"_S_"4")
End DoDot:1
+7 QUIT
CARH WRITE ?6,"Care Area",?25,"Current Level",?46,"Care Area",?67,"Current Level"
+1 WRITE !,"-----------------------",?25,"-------------",?40,"-------------------------",?67,"-------------"
+2 QUIT
HEAD DO HEAD^ANSEAV
+1 QUIT
SUBH SET Y=ANSDT
+1 XECUTE ^DD("DD")
+2 WRITE !!,?3,Y
+3 SET Y=""
SET ANSS=$PIECE(ANSPAR,U,5)
+4 IF $DATA(ANSSH)
SET X=$TEXT(@ANSS)
SET Y=$PIECE($PIECE(X,";;",ANSSH+1),U,2)
WRITE ?22,Y," Shift"
+5 IF '$DATA(^ANSD(59.1,+$GET(ANSUN),0))
QUIT
+6 SET Z=$PIECE(^ANSD(59.1,ANSUN,0),U)
+7 WRITE ?45,"Unit ",Z
+8 SET Y=$PIECE(ANSDX,U,3)
+9 IF Y
IF $DATA(^ANSD(59.1,ANSUN,"R",Y,0))
Begin DoDot:1
+10 WRITE " Rm ",$PIECE(^ANSD(59.1,ANSUN,"R",Y,0),U)
+11 SET Y=$PIECE(ANSDX,U,4)
+12 IF Y
IF $DATA(^ANSD(59.1,ANSUN,"R",Y,"B",Y,0))
WRITE "-",$PIECE(^(0),U)
End DoDot:1
+13 QUIT
DISP DO HEAD
DO SUBH
+1 WRITE !
+2 QUIT
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
