ANSUCK.m

ANSUCK ;IHS/OIRM/DSD/CSC - UTILITY TO CHECK ADMISSION; [ 02/25/98  10:32 AM ]

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

 ;;UTILITY TO CHECK ADMISSION

ANEW S L=0,N=$O(^ANSR("AA",ANSDFN,0)),H=DT_".9"

 I N S N=$O(^ANSR("AA",ANSDFN,N,0)) D DC

 I X'>L W !!,"  Can't Be Prior To The Last Discharge." G NO

 I X>H W !!,"  Can't Be Greater Than Today." G NO

 G OK

AOLD S L=0,H=$O(^ANSR(A,"AT",0)),D=9999998-^ANSR(A,0)

 I 'H S H=DT_".9"

A1 S D=$O(^ANSR("AA",ANSDFN,D)),N=0 G A3:D=""

 S N=""

A2 S N=$O(^ANSR("AA",ANSDFN,D,N)) G A1:N="",A1:N=A

A3 D DC

 I X'>L W !!,"  Must Be After The Prior Discharge." G NO

 I X>H W !!,"  Must Be Before The Date Of The First Care Level Record." G NO

 G OK

DNEW S H=DT_".9",L=0 D LI

 I X<L W !!," Can't Be Prior To The Date Of The Last Care Level Record." G NO

 I X>H W *7,"  Can't Be Greater Than Today." G NO

 G OK

DOLD D LI S H=DT_"."_9,P=0

 G D3:'$D(^ANSR(A,0)) S C=9999999-^(0),N=0,D=0

D1 S D=$O(^ANSR("AA",ANSDFN,D)) G D3:D="",D3:D>C

 S N=0

D2 S N=$O(^ANSR("AA",ANSDFN,D,N)) G D1:N="",D1:N=A

 S P=N

 G D2

D3 I P,$D(^ANSR(P,0)) S H=$P(^ANSR(P,0),U)_"."_$P(^ANSR(P,0),U,2)

 I X<L W !!,"  Can't Be Less Than The Date Of The Last Care Level Record." G NO

 I X'<H W !!,"  Can't Be After The Next Admission." G NO

 G OK

NO K Y

 W *7

 D PAUSE^ANSDIC

OK Q

DC I N,$D(^ANSR(N,"DX")) S N=$P(^ANSR(N,"DX"),U,5) I N,$D(^ANSR(N,0)) S L=$P(^ANSR(N,0),U)_"."_$P(^ANSR(N,0),U,2)

 Q

LI I $D(^ANSR(A,0)) S L=$P(^ANSR(A,0),U)_"."_$P(^ANSR(A,0),U,2)

 S N="" F I=1:1 S N=$O(^ANSR(A,"AT",N)) Q:N=""  S L=N

 Q

ANSUCK    ;IHS/OIRM/DSD/CSC - UTILITY TO CHECK ADMISSION; [ 02/25/98  10:32 AM ]

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

 +2       ;;UTILITY TO CHECK ADMISSION

ANEW       SET L=0

           SET N=$ORDER(^ANSR("AA",ANSDFN,0))

           SET H=DT_".9"

 +1        IF N

               SET N=$ORDER(^ANSR("AA",ANSDFN,N,0))

               DO DC

 +2        IF X'>L

               WRITE !!,"  Can't Be Prior To The Last Discharge."

               GOTO NO

 +3        IF X>H

               WRITE !!,"  Can't Be Greater Than Today."

               GOTO NO

 +4        GOTO OK

AOLD       SET L=0

           SET H=$ORDER(^ANSR(A,"AT",0))

           SET D=9999998-^ANSR(A,0)

 +1        IF 'H

               SET H=DT_".9"

A1         SET D=$ORDER(^ANSR("AA",ANSDFN,D))

           SET N=0

           IF D=""

               GOTO A3

 +1        SET N=""

A2         SET N=$ORDER(^ANSR("AA",ANSDFN,D,N))

           IF N=""

               GOTO A1

           IF N=A

               GOTO A1

A3         DO DC

 +1        IF X'>L

               WRITE !!,"  Must Be After The Prior Discharge."

               GOTO NO

 +2        IF X>H

               WRITE !!,"  Must Be Before The Date Of The First Care Level Record."

               GOTO NO

 +3        GOTO OK

DNEW       SET H=DT_".9"

           SET L=0

           DO LI

 +1        IF X<L

               WRITE !!," Can't Be Prior To The Date Of The Last Care Level Record."

               GOTO NO

 +2        IF X>H

               WRITE *7,"  Can't Be Greater Than Today."

               GOTO NO

 +3        GOTO OK

DOLD       DO LI

           SET H=DT_"."_9

           SET P=0

 +1        IF '$DATA(^ANSR(A,0))

               GOTO D3

           SET C=9999999-^(0)

           SET N=0

           SET D=0

D1         SET D=$ORDER(^ANSR("AA",ANSDFN,D))

           IF D=""

               GOTO D3

           IF D>C

               GOTO D3

 +1        SET N=0

D2         SET N=$ORDER(^ANSR("AA",ANSDFN,D,N))

           IF N=""

               GOTO D1

           IF N=A

               GOTO D1

 +1        SET P=N

 +2        GOTO D2

D3         IF P

               IF $DATA(^ANSR(P,0))

                   SET H=$PIECE(^ANSR(P,0),U)_"."_$PIECE(^ANSR(P,0),U,2)

 +1        IF X<L

               WRITE !!,"  Can't Be Less Than The Date Of The Last Care Level Record."

               GOTO NO

 +2        IF X'<H

               WRITE !!,"  Can't Be After The Next Admission."

               GOTO NO

 +3        GOTO OK

NO         KILL Y

 +1        WRITE *7

 +2        DO PAUSE^ANSDIC

OK         QUIT 

DC         IF N

               IF $DATA(^ANSR(N,"DX"))

                   SET N=$PIECE(^ANSR(N,"DX"),U,5)

                   IF N

                       IF $DATA(^ANSR(N,0))

                           SET L=$PIECE(^ANSR(N,0),U)_"."_$PIECE(^ANSR(N,0),U,2)

 +1        QUIT 

LI         IF $DATA(^ANSR(A,0))

               SET L=$PIECE(^ANSR(A,0),U)_"."_$PIECE(^ANSR(A,0),U,2)

 +1        SET N=""

           FOR I=1:1

               SET N=$ORDER(^ANSR(A,"AT",N))

               IF N=""

                   QUIT 

               SET L=N

 +2        QUIT