- 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