ANSQPAS.m

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

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

 ;;PRINT PATIENT ACUITY REPORTS

 I '$D(ANSPAR) S ANSPAR=^ANSD(51,1,0)

A0 D HEAD^ANSQPAA

 I $D(ANSUNIT) D SB1

 S ANSPT=0

A1 F  S ANSPT=$O(^TMP("ANS",ANSJOB,"P",ANSPT)) Q:ANSPT=""  D

 .S ANSDFN=0

A2 .S ANSDFN=$O(^TMP("ANS",ANSJOB,"P",ANSPT,ANSDFN)) Q:ANSDFN=""  D

 ..S ANSADM=^TMP("ANS",ANSJOB,"P",ANSPT,ANSDFN)

 ..D ^ANSQPAA

 W:$D(IOF) @IOF

 Q

SB1 S ANSDFN="",ANSJOB=$J

 F  S ANSDFN=$O(^ANSR("PT",ANSDFN)) Q:ANSDFN=""  D

 .Q:'$D(^DPT(ANSDFN,0))

 .S X=$P(^DPT(ANSDFN,0),U)

 .S ANSADM=0

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

 ..Q:'$D(^ANSR(ANSADM,0))

 ..Q:'$D(^ANSR(ANSADM,"DX"))

 ..Q:$P(^ANSR(ANSADM,"DX"),U,2)'=ANSUNIT

 ..S ^TMP("ANS",$J,"P",$E(X,1,30),ANSDFN)=ANSADM

 Q

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

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

 +2       ;;PRINT PATIENT ACUITY REPORTS

 +3        IF '$DATA(ANSPAR)

               SET ANSPAR=^ANSD(51,1,0)

A0         DO HEAD^ANSQPAA

 +1        IF $DATA(ANSUNIT)

               DO SB1

 +2        SET ANSPT=0

A1         FOR 

               SET ANSPT=$ORDER(^TMP("ANS",ANSJOB,"P",ANSPT))

               IF ANSPT=""

                   QUIT 

               Begin DoDot:1

 +1                SET ANSDFN=0

A2                 SET ANSDFN=$ORDER(^TMP("ANS",ANSJOB,"P",ANSPT,ANSDFN))

                   IF ANSDFN=""

                       QUIT 

                   Begin DoDot:2

 +1                    SET ANSADM=^TMP("ANS",ANSJOB,"P",ANSPT,ANSDFN)

 +2                    DO ^ANSQPAA

                   End DoDot:2

               End DoDot:1

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        QUIT 

SB1        SET ANSDFN=""

           SET ANSJOB=$JOB

 +1        FOR 

               SET ANSDFN=$ORDER(^ANSR("PT",ANSDFN))

               IF ANSDFN=""

                   QUIT 

               Begin DoDot:1

 +2                IF '$DATA(^DPT(ANSDFN,0))

                       QUIT 

 +3                SET X=$PIECE(^DPT(ANSDFN,0),U)

 +4                SET ANSADM=0

 +5                FOR 

                       SET ANSADM=$ORDER(^ANSR("PT",ANSDFN,ANSADM))

                       IF ANSADM=""

                           QUIT 

                       Begin DoDot:2

 +6                        IF '$DATA(^ANSR(ANSADM,0))

                               QUIT 

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

                               QUIT 

 +8                        IF $PIECE(^ANSR(ANSADM,"DX"),U,2)'=ANSUNIT

                               QUIT 

 +9                        SET ^TMP("ANS",$JOB,"P",$EXTRACT(X,1,30),ANSDFN)=ANSADM

                       End DoDot:2

               End DoDot:1

 +10       QUIT