- ANSEA1 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ACUITY DATA; [ 02/25/98 10:32 AM ]
- ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
- ;ENTER/EDIT CONTINUED
- EN F D EN1 Q:$D(DTOUT)!$D(DUOUT)
- D ^ANSEA2
- EXIT K ANS
- Q
- EN1 D ^ANSEAV1
- S DIR(0)="SO^1:Edit Care Levels;2:Edit Adjustment Factors;3:Edit Room/Bed/Diagnosis;4:Edit ALL"
- I ANSTOT<10 S Y=4
- E D DIR^ANSDIC
- I $D(DTOUT)!$D(DUOUT)!(+$G(Y)<1) S DUOUT="" Q
- I Y=1 D CARE S Y=1
- I Y=2 D ADJUST S Y=2
- I Y=3 D ROOM S Y=3
- I Y=4 D ALL S Y=4
- Q
- ALL D CARE
- Q:$D(DTOUT)!$D(DUOUT)
- D ADJUST
- Q:$D(DTOUT)!$D(DUOUT)
- D ROOM
- Q:$D(DTOUT)!$D(DUOUT)
- Q
- CARE D ^ANSEAL
- Q
- ADJUST D ^ANSEAF
- Q
- ROOM S ANSDX=$G(^ANSR(ANSADM,"DX"))
- S X=$P(ANSDX,U,2)
- I X'=ANSUN S $P(ANSDX,U,2)=ANSUN F I=3,4 S $P(ANSDX,U,I)=""
- D ^ANSUEU
- I $P(ANSDX,U)]"",$P(^ANSR(ANSADM,"DX"),U)'=$P(ANSDX,U) D
- .S DIE="^ANSR(",DA=ANSADM,DR="2////"_X ;;CSC 8-97
- .D DIE^ANSDIC
- Q
- ANSEA1 ;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 CONTINUED
- EN FOR
- DO EN1
- IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +1 DO ^ANSEA2
- EXIT KILL ANS
- +1 QUIT
- EN1 DO ^ANSEAV1
- +1 SET DIR(0)="SO^1:Edit Care Levels;2:Edit Adjustment Factors;3:Edit Room/Bed/Diagnosis;4:Edit ALL"
- +2 IF ANSTOT<10
- SET Y=4
- +3 IF '$TEST
- DO DIR^ANSDIC
- +4 IF $DATA(DTOUT)!$DATA(DUOUT)!(+$GET(Y)<1)
- SET DUOUT=""
- QUIT
- +5 IF Y=1
- DO CARE
- SET Y=1
- +6 IF Y=2
- DO ADJUST
- SET Y=2
- +7 IF Y=3
- DO ROOM
- SET Y=3
- +8 IF Y=4
- DO ALL
- SET Y=4
- +9 QUIT
- ALL DO CARE
- +1 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +2 DO ADJUST
- +3 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +4 DO ROOM
- +5 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +6 QUIT
- CARE DO ^ANSEAL
- +1 QUIT
- ADJUST DO ^ANSEAF
- +1 QUIT
- ROOM SET ANSDX=$GET(^ANSR(ANSADM,"DX"))
- +1 SET X=$PIECE(ANSDX,U,2)
- +2 IF X'=ANSUN
- SET $PIECE(ANSDX,U,2)=ANSUN
- FOR I=3,4
- SET $PIECE(ANSDX,U,I)=""
- +3 DO ^ANSUEU
- +4 IF $PIECE(ANSDX,U)]""
- IF $PIECE(^ANSR(ANSADM,"DX"),U)'=$PIECE(ANSDX,U)
- Begin DoDot:1
- +5 ;;CSC 8-97
- SET DIE="^ANSR("
- SET DA=ANSADM
- SET DR="2////"_X
- +6 DO DIE^ANSDIC
- End DoDot:1
- +7 QUIT