- 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
