ANSEA2.m

ANSEA2 ;IHS/OIRM/DSD/CSC - FILE ACUITY DATA; [ 02/25/98  10:32 AM ]

 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996

 ;SET ACUITY DATA

EN K:ANSDA ^ANSR(ANSDA,"F")

 I 'ANSDA D FILE

 S DA=ANSDA,DIE="^ANSR(",DR=".02////"_ANSSH_";.03////"_ANSUN_";.04////"_ANSDFN_";.05////O;.06////"_ANSADM_";.07////"_DUZ,D=ANSDT_"."_ANSSH

 D DIE^ANSDIC

 S:'$D(^ANSR(ANSDA,"L",0)) ^ANSR(ANSDA,"L",0)="^9009052.1PA"

 F ANSI=1:1:10 D

 .I '$D(^ANSR(ANSDA,"L",ANSI,0)) D

 ..S DA(1)=ANSDA,DIC="^ANSR("_ANSDA_",""L"",",DIC(0)="L",(DINUM,X)=ANSI

 ..D FILE^ANSDIC

 .S DA(1)=ANSDA,DA=ANSI,DIE="^ANSR("_ANSDA_",""L"",",DR="1////"_$P(ANSCL,U,ANSI)

 .D DIE^ANSDIC

FACTOR ;EP

 Q:ANSAF=""

 S:'$D(^ANSR(ANSDA,"F",0)) ^ANSR(ANSDA,"F",0)="^9009052.01P^"

 F ANSI=1:1:$L(ANSAF,U) S ANSX=$P(ANSAF,U,ANSI) I ANSX,'$D(^ANSR(ANSDA,"F",ANSX,0)) D

 .S DA(1)=ANSDA,DIC="^ANSR("_ANSDA_",""F"",",DIC(0)="L",(DINUM,X)=ANSX

 .D FILE^ANSDIC

 Q

FILE ;EP;TO FILE NEW ASSESSMENT

 S X=ANSDT,DIC="^ANSR(",DIC(0)="L"

 D FILE^ANSDIC

 S ANSDA=+Y

 D EN

 Q 

DELET ;EP;CSC/DSD/1-97

 S DA=+Y,DA(1)=ANSDA,DIK="^ANSR("_DA(1)_",""F""," D DIK^ANSDIC

 Q

ANSEA2    ;IHS/OIRM/DSD/CSC - FILE ACUITY DATA; [ 02/25/98  10:32 AM ]

 +1       ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996

 +2       ;SET ACUITY DATA

EN         IF ANSDA

               KILL ^ANSR(ANSDA,"F")

 +1        IF 'ANSDA

               DO FILE

 +2        SET DA=ANSDA

           SET DIE="^ANSR("

           SET DR=".02////"_ANSSH_";.03////"_ANSUN_";.04////"_ANSDFN_";.05////O;.06////"_ANSADM_";.07////"_DUZ

           SET D=ANSDT_"."_ANSSH

 +3        DO DIE^ANSDIC

 +4        IF '$DATA(^ANSR(ANSDA,"L",0))

               SET ^ANSR(ANSDA,"L",0)="^9009052.1PA"

 +5        FOR ANSI=1:1:10

               Begin DoDot:1

 +6                IF '$DATA(^ANSR(ANSDA,"L",ANSI,0))

                       Begin DoDot:2

 +7                        SET DA(1)=ANSDA

                           SET DIC="^ANSR("_ANSDA_",""L"","

                           SET DIC(0)="L"

                           SET (DINUM,X)=ANSI

 +8                        DO FILE^ANSDIC

                       End DoDot:2

 +9                SET DA(1)=ANSDA

                   SET DA=ANSI

                   SET DIE="^ANSR("_ANSDA_",""L"","

                   SET DR="1////"_$PIECE(ANSCL,U,ANSI)

 +10               DO DIE^ANSDIC

               End DoDot:1

FACTOR    ;EP

 +1        IF ANSAF=""

               QUIT 

 +2        IF '$DATA(^ANSR(ANSDA,"F",0))

               SET ^ANSR(ANSDA,"F",0)="^9009052.01P^"

 +3        FOR ANSI=1:1:$LENGTH(ANSAF,U)

               SET ANSX=$PIECE(ANSAF,U,ANSI)

               IF ANSX

                   IF '$DATA(^ANSR(ANSDA,"F",ANSX,0))

                       Begin DoDot:1

 +4                        SET DA(1)=ANSDA

                           SET DIC="^ANSR("_ANSDA_",""F"","

                           SET DIC(0)="L"

                           SET (DINUM,X)=ANSX

 +5                        DO FILE^ANSDIC

                       End DoDot:1

 +6        QUIT 

FILE      ;EP;TO FILE NEW ASSESSMENT

 +1        SET X=ANSDT

           SET DIC="^ANSR("

           SET DIC(0)="L"

 +2        DO FILE^ANSDIC

 +3        SET ANSDA=+Y

 +4        DO EN

 +5        QUIT 

DELET     ;EP;CSC/DSD/1-97

 +1        SET DA=+Y

           SET DA(1)=ANSDA

           SET DIK="^ANSR("_DA(1)_",""F"","

           DO DIK^ANSDIC

 +2        QUIT