Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ANSEA1

ANSEA1.m

Go to the documentation of this file.
  1. ANSEA1 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ACUITY DATA; [ 02/25/98 10:32 AM ]
  1. ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
  1. ;ENTER/EDIT CONTINUED
  1. EN F D EN1 Q:$D(DTOUT)!$D(DUOUT)
  1. D ^ANSEA2
  1. EXIT K ANS
  1. Q
  1. EN1 D ^ANSEAV1
  1. S DIR(0)="SO^1:Edit Care Levels;2:Edit Adjustment Factors;3:Edit Room/Bed/Diagnosis;4:Edit ALL"
  1. I ANSTOT<10 S Y=4
  1. E D DIR^ANSDIC
  1. I $D(DTOUT)!$D(DUOUT)!(+$G(Y)<1) S DUOUT="" Q
  1. I Y=1 D CARE S Y=1
  1. I Y=2 D ADJUST S Y=2
  1. I Y=3 D ROOM S Y=3
  1. I Y=4 D ALL S Y=4
  1. Q
  1. ALL D CARE
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. D ADJUST
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. D ROOM
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. Q
  1. CARE D ^ANSEAL
  1. Q
  1. ADJUST D ^ANSEAF
  1. Q
  1. ROOM S ANSDX=$G(^ANSR(ANSADM,"DX"))
  1. S X=$P(ANSDX,U,2)
  1. I X'=ANSUN S $P(ANSDX,U,2)=ANSUN F I=3,4 S $P(ANSDX,U,I)=""
  1. D ^ANSUEU
  1. I $P(ANSDX,U)]"",$P(^ANSR(ANSADM,"DX"),U)'=$P(ANSDX,U) D
  1. .S DIE="^ANSR(",DA=ANSADM,DR="2////"_X ;;CSC 8-97
  1. .D DIE^ANSDIC
  1. Q