- 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
