ANSQPP1 ;IHS/OIRM/DSD/CSC - PRINT PATIENT ACUITY REPORT; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;PRINT PATIENT ACUITY REPORT
A1 Q:'$D(ANSDFN)
Q:'$D(^DPT(ANSDFN,0))
D HEAD
S X=$P(^DPT(ANSDFN,0),U)
W !,$P(X,",",1),", ",$P(X,",",2,99)
I $D(^AUPNPAT(ANSDFN,41,ANSSITE,0)) S X=$P(^(0),U,2) I X]"" W " (",X,")"
D SUBH
A2 S T=0
D CARH
F I=1:1:10 D SBW I I=2!(I=7) D PAUSE^ANSDIC
W !!,"Adj. Factors: "
W:ANSAF="" "None Listed"
F I=1:1 S X=$P(ANSAF,U,I) Q:X="" D
.I $D(^ANSD(59.3,X,0)) S X=$P(^(0),U,2),S=$P(^(0),U,3),L=$L(X) 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")
S L=$O(^ANSD(51.1,1,"K",T-1))
I L,$D(^ANSD(51.1,1,"K",L,0)) S L=$P(^(0),U,2),X=$P(^(0),U,3)
W !,"Total Weight: "
I T<34 W T
E W:IOST["C-" @ANSRVON W " ",T,@ANSSPAC W:IOST["C-" @ANSRVOF
W ?25,"Nursing Care Level: "
I X'["V" W L," - ",X
E D
.W:IOST["C-" @ANSRVON
.W L," - ",X W:IOST["C-" @ANSSPAC ;CSC 10-28-96
.W:IOST["C-" @ANSRVOF
D PAUSE^ANSDIC
Q
SBW W !
S S=I
W S
D AREA
Q
AREA I $D(^ANSD(59,S,0)) S ANS=^(0) W " ",$P(ANS,U),"(",$P(ANS,U,2)," levs)"
S L=$P(ANSCL,U,S)
Q:L<1
I L>4,$P(^ANSD(59,S,0),U,L) S T=T+$P(^(0),U,L)
E S T=T+L
I L>3 D I 1
.W ?29
.W:IOST["C-" @ANSRVON
.W " ",L," *" W:IOST["C-" @ANSSPAC ;CSC 10-28-96
.W:IOST["C-" @ANSRVOF
.W " "
E W ?31,L
S L="D"_L
I $D(^ANSD(59,S,L)) S X=^(L) W ?40
S (K,C)=0,M=$L(X," ")+1
S11 S K=K+1
G S19:K=M
S W=$P(X," ",K)
I $L(W)+1+$X<79 W:C " " W W S C=1 G S11
W !,?40,W
S C=1
G S11
S19 Q
CARH W !!,?6,"Care Area",?25,"Current Level",?54,"Description"
W !,"-----------------------",?25,"-------------",?40,"---------------------------------------"
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"
G SUBH9:'ANSUN,SUBH9:'$D(^ANSD(59.1,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)) W " Rm ",$P(^(0),U) S Y=$P(ANSDX,U,4) I Y,$D(^("B",Y,0)) W "-",$P(^(0),U)
SUBH9 W !!," Diagnosis: "
W:IOST["C-" @ANSRVON
W $P(ANSDX,U),@ANSSPAC
W:IOST["C-" @ANSRVOF
Q
DISP D HEAD,SUBH
W !
Q
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
ANSQPP1 ;IHS/OIRM/DSD/CSC - PRINT PATIENT ACUITY REPORT; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;;PRINT PATIENT ACUITY REPORT
A1 IF '$DATA(ANSDFN)
QUIT
+1 IF '$DATA(^DPT(ANSDFN,0))
QUIT
+2 DO HEAD
+3 SET X=$PIECE(^DPT(ANSDFN,0),U)
+4 WRITE !,$PIECE(X,",",1),", ",$PIECE(X,",",2,99)
+5 IF $DATA(^AUPNPAT(ANSDFN,41,ANSSITE,0))
SET X=$PIECE(^(0),U,2)
IF X]""
WRITE " (",X,")"
+6 DO SUBH
A2 SET T=0
+1 DO CARH
+2 FOR I=1:1:10
DO SBW
IF I=2!(I=7)
DO PAUSE^ANSDIC
+3 WRITE !!,"Adj. Factors: "
+4 IF ANSAF=""
WRITE "None Listed"
+5 FOR I=1:1
SET X=$PIECE(ANSAF,U,I)
IF X=""
QUIT
Begin DoDot:1
+6 IF $DATA(^ANSD(59.3,X,0))
SET X=$PIECE(^(0),U,2)
SET S=$PIECE(^(0),U,3)
SET L=$LENGTH(X)
IF $X+L>74
WRITE !,?14
IF I>1
WRITE ","
IF IOST["C-"
WRITE @ANSRVON
WRITE @ANSSPAC,X,@ANSSPAC
IF IOST["C-"
WRITE @ANSRVOF
IF S]""
SET @("T=T"_S_"4")
End DoDot:1
+7 SET L=$ORDER(^ANSD(51.1,1,"K",T-1))
+8 IF L
IF $DATA(^ANSD(51.1,1,"K",L,0))
SET L=$PIECE(^(0),U,2)
SET X=$PIECE(^(0),U,3)
+9 WRITE !,"Total Weight: "
+10 IF T<34
WRITE T
+11 IF '$TEST
IF IOST["C-"
WRITE @ANSRVON
WRITE " ",T,@ANSSPAC
IF IOST["C-"
WRITE @ANSRVOF
+12 WRITE ?25,"Nursing Care Level: "
+13 IF X'["V"
WRITE L," - ",X
+14 IF '$TEST
Begin DoDot:1
+15 IF IOST["C-"
WRITE @ANSRVON
+16 ;CSC 10-28-96
WRITE L," - ",X
IF IOST["C-"
WRITE @ANSSPAC
+17 IF IOST["C-"
WRITE @ANSRVOF
End DoDot:1
+18 DO PAUSE^ANSDIC
+19 QUIT
SBW WRITE !
+1 SET S=I
+2 WRITE S
+3 DO AREA
+4 QUIT
AREA IF $DATA(^ANSD(59,S,0))
SET ANS=^(0)
WRITE " ",$PIECE(ANS,U),"(",$PIECE(ANS,U,2)," levs)"
+1 SET L=$PIECE(ANSCL,U,S)
+2 IF L<1
QUIT
+3 IF L>4
IF $PIECE(^ANSD(59,S,0),U,L)
SET T=T+$PIECE(^(0),U,L)
+4 IF '$TEST
SET T=T+L
+5 IF L>3
Begin DoDot:1
+6 WRITE ?29
+7 IF IOST["C-"
WRITE @ANSRVON
+8 ;CSC 10-28-96
WRITE " ",L," *"
IF IOST["C-"
WRITE @ANSSPAC
+9 IF IOST["C-"
WRITE @ANSRVOF
+10 WRITE " "
End DoDot:1
IF 1
+11 IF '$TEST
WRITE ?31,L
+12 SET L="D"_L
+13 IF $DATA(^ANSD(59,S,L))
SET X=^(L)
WRITE ?40
+14 SET (K,C)=0
SET M=$LENGTH(X," ")+1
S11 SET K=K+1
+1 IF K=M
GOTO S19
+2 SET W=$PIECE(X," ",K)
+3 IF $LENGTH(W)+1+$X<79
IF C
WRITE " "
WRITE W
SET C=1
GOTO S11
+4 WRITE !,?40,W
+5 SET C=1
+6 GOTO S11
S19 QUIT
CARH WRITE !!,?6,"Care Area",?25,"Current Level",?54,"Description"
+1 WRITE !,"-----------------------",?25,"-------------",?40,"---------------------------------------"
+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 'ANSUN
GOTO SUBH9
IF '$DATA(^ANSD(59.1,ANSUN,0))
GOTO SUBH9
+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))
WRITE " Rm ",$PIECE(^(0),U)
SET Y=$PIECE(ANSDX,U,4)
IF Y
IF $DATA(^("B",Y,0))
WRITE "-",$PIECE(^(0),U)
SUBH9 WRITE !!," Diagnosis: "
+1 IF IOST["C-"
WRITE @ANSRVON
+2 WRITE $PIECE(ANSDX,U),@ANSSPAC
+3 IF IOST["C-"
WRITE @ANSRVOF
+4 QUIT
DISP DO HEAD
DO SUBH
+1 WRITE !
+2 QUIT
2 ;;1^DAY;;2^NIGHT
3 ;;1^DAY;;2^EVENING;;3^NIGHT
