Routine: ANSQPP

ANSQPP ;IHS/OIRM/DSD/CSC - PRINT PATIENT ACUITY REPORT; [ 02/25/98  10:32 AM ]

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

 ;;PRINT PATIENT ACUITY REPORT

 W:$G(IOST)["C-" @IOF

CUR S M=0,X=DT_".9",ANSDX=""

 I $D(^ANSR(ANSADM,"DX")) S ANSDX=^("DX")

 F  S M=$O(^ANSR(ANSADM,"AT",M)) Q:M=""!(M>X)  D

 .I M>X D C3 Q

 .S O=0,ANSMR=M

 .F  S O=$O(^ANSR(ANSADM,"AT",M,O)) Q:O=""  D

 ..I $D(^ANSR(O,0)),$P(^(0),U,5)="D" S A=0 Q

 ..E  S N=O

 D C3

C3 S (ANSCL,ANSAF)=""

 I N,$D(^ANSR(N,0)) S ANSDT=$P(^(0),U),ANSSH=$P(^(0),U,2),ANSUN=$P(^(0),U,3)

D:N

 .S M=0 F I=1:1 S M=$O(^ANSR(N,"L",M)) Q:M<1  I $D(^(M,0)) S $P(ANSCL,U,M)=$P(^(0),U,2)

 .S M=0 F I=1:1 S M=$O(^ANSR(N,"F",M)) Q:M=""  I $D(^(M,0)) S:ANSAF]"" ANSAF=ANSAF_U S ANSAF=ANSAF_M

 D ^ANSQPP1

ANSQPP    ;IHS/OIRM/DSD/CSC - PRINT PATIENT ACUITY REPORT; [ 02/25/98  10:32 AM ]

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

 +2       ;;PRINT PATIENT ACUITY REPORT

 +3        IF $GET(IOST)["C-"

               WRITE @IOF

CUR        SET M=0

           SET X=DT_".9"

           SET ANSDX=""

 +1        IF $DATA(^ANSR(ANSADM,"DX"))

               SET ANSDX=^("DX")

 +2        FOR

               SET M=$ORDER(^ANSR(ANSADM,"AT",M))

               IF M=""!(M>X)

                   QUIT

               Begin DoDot:1

 +3                IF M>X

                       DO C3

                       QUIT

 +4                SET O=0

                   SET ANSMR=M

 +5                FOR

                       SET O=$ORDER(^ANSR(ANSADM,"AT",M,O))

                       IF O=""

                           QUIT

                       Begin DoDot:2

 +6                        IF $DATA(^ANSR(O,0))

                               IF $PIECE(^(0),U,5)="D"

                                   SET A=0

                                   QUIT

 +7                       IF '$TEST

                               SET N=O

                       End DoDot:2

               End DoDot:1

 +8        DO C3

 +9        QUIT

C3         SET (ANSCL,ANSAF)=""

 +1        IF N

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

                   SET ANSDT=$PIECE(^(0),U)

                   SET ANSSH=$PIECE(^(0),U,2)

                   SET ANSUN=$PIECE(^(0),U,3)

 +2        IF N

               Begin DoDot:1

 +3                SET M=0

                   FOR I=1:1

                       SET M=$ORDER(^ANSR(N,"L",M))

                       IF M<1

                           QUIT

                       IF $DATA(^(M,0))

                           SET $PIECE(ANSCL,U,M)=$PIECE(^(0),U,2)

 +4                SET M=0

                   FOR I=1:1

                       SET M=$ORDER(^ANSR(N,"F",M))

                       IF M=""

                           QUIT

                       IF $DATA(^(M,0))

                           IF ANSAF]""

                               SET ANSAF=ANSAF_U

                           SET ANSAF=ANSAF_M

               End DoDot:1

 +5        DO ^ANSQPP1

 +6        QUIT

ANSQPP.m