ANSQPS.m

ANSQPS ;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

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

 I $D(ANSUNIT) D SB1

 S ANSPTX=""

 F  S ANSPTX=$O(^TMP("ANS",ANSJOB,"P",ANSPTX)) Q:ANSPTX=""!$D(DTOUT)!$D(DUOUT)  D

 .S ANSDFN=0

 .F  S ANSDFN=$O(^TMP("ANS",ANSJOB,"P",ANSPTX,ANSDFN)) Q:ANSDFN=""!$D(DTOUT)!$D(DUOUT)  D

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

 ..D ^ANSQPP

 I $G(IOST)["P-" W @IOF

 K ^TMP("ANS",ANSJOB)

 Q

SB1 S ANSDFN=""

 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",ANSJOB,"P",$E(X,1,30),ANSDFN)=ANSADM

 Q

ANSQPS    ;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

EN         IF '$DATA(ANSPAR)

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

 +1        IF $DATA(ANSUNIT)

               DO SB1

 +2        SET ANSPTX=""

 +3        FOR 

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

               IF ANSPTX=""!$DATA(DTOUT)!$DATA(DUOUT)

                   QUIT 

               Begin DoDot:1

 +4                SET ANSDFN=0

 +5                FOR 

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

                       IF ANSDFN=""!$DATA(DTOUT)!$DATA(DUOUT)

                           QUIT 

                       Begin DoDot:2

 +6                        SET ANSADM=^TMP("ANS",ANSJOB,"P",ANSPTX,ANSDFN)

 +7                        DO ^ANSQPP

                       End DoDot:2

               End DoDot:1

 +8        IF $GET(IOST)["P-"

               WRITE @IOF

 +9        KILL ^TMP("ANS",ANSJOB)

 +10       QUIT 

SB1        SET ANSDFN=""

 +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",ANSJOB,"P",$EXTRACT(X,1,30),ANSDFN)=ANSADM

                       End DoDot:2

               End DoDot:1

 +10       QUIT