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

ANSEA2.m

Go to the documentation of this file.
  1. ANSEA2 ;IHS/OIRM/DSD/CSC - FILE ACUITY DATA; [ 02/25/98 10:32 AM ]
  1. ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
  1. ;SET ACUITY DATA
  1. EN K:ANSDA ^ANSR(ANSDA,"F")
  1. I 'ANSDA D FILE
  1. S DA=ANSDA,DIE="^ANSR(",DR=".02////"_ANSSH_";.03////"_ANSUN_";.04////"_ANSDFN_";.05////O;.06////"_ANSADM_";.07////"_DUZ,D=ANSDT_"."_ANSSH
  1. D DIE^ANSDIC
  1. S:'$D(^ANSR(ANSDA,"L",0)) ^ANSR(ANSDA,"L",0)="^9009052.1PA"
  1. F ANSI=1:1:10 D
  1. .I '$D(^ANSR(ANSDA,"L",ANSI,0)) D
  1. ..S DA(1)=ANSDA,DIC="^ANSR("_ANSDA_",""L"",",DIC(0)="L",(DINUM,X)=ANSI
  1. ..D FILE^ANSDIC
  1. .S DA(1)=ANSDA,DA=ANSI,DIE="^ANSR("_ANSDA_",""L"",",DR="1////"_$P(ANSCL,U,ANSI)
  1. .D DIE^ANSDIC
  1. FACTOR ;EP
  1. Q:ANSAF=""
  1. S:'$D(^ANSR(ANSDA,"F",0)) ^ANSR(ANSDA,"F",0)="^9009052.01P^"
  1. F ANSI=1:1:$L(ANSAF,U) S ANSX=$P(ANSAF,U,ANSI) I ANSX,'$D(^ANSR(ANSDA,"F",ANSX,0)) D
  1. .S DA(1)=ANSDA,DIC="^ANSR("_ANSDA_",""F"",",DIC(0)="L",(DINUM,X)=ANSX
  1. .D FILE^ANSDIC
  1. Q
  1. FILE ;EP;TO FILE NEW ASSESSMENT
  1. S X=ANSDT,DIC="^ANSR(",DIC(0)="L"
  1. D FILE^ANSDIC
  1. S ANSDA=+Y
  1. D EN
  1. Q
  1. DELET ;EP;CSC/DSD/1-97
  1. S DA=+Y,DA(1)=ANSDA,DIK="^ANSR("_DA(1)_",""F""," D DIK^ANSDIC
  1. Q