ANSQPAA.m

ANSQPAA ;IHS/OIRM/DSD/CSC - SETUP FOR ASSESSMENT HISTORY PRINTOUT; [ 07/07/1999  2:52 PM ]

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

 ;;SETUP FOR ASSESSMENT HISTORY PRINTOUT

A1 Q:'$D(ANSDFN)

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

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

 D PREP

 Q

PREP ;PRINT REPORT

 S ANSINPT=ANSPT

 D NAME

 Q

NAME ;PRINT PATIENT NAME

 ;S ANSY=ANSADM Q:ANSY=""

 S ANSPUNIT=$P(^ANSR(ANSADM,"DX"),U,2),ANSUNIT=$S(ANSPUNIT]"":^ANSD(59.1,ANSPUNIT,0),1:"NOT SPECIFIED")

 W:ANSINPT]"" !,?4,ANSINPT,?36,ANSUNIT

 S ANSCA=""

 F I=0:0 S ANSCA=$O(^ANSR(ANSADM,"AT",ANSCA)) Q:ANSCA=""  D DATA

 D PAUSE^ANSDIC

 Q

DATA ;PRINT DATA

 D COUNT

 W ?53,$E(ANSCA,4,5)_"-"_$E(ANSCA,6,7)_"-"_($E(ANSCA,1,3)+1700),?65,$E(ANSCA,9),!    ;Y2000

 Q

HEAD ;EP

 S ANSHEAD=""

 D HISTORY^ANSQ

 K ANSHEAD

REPHEAD ;REPORT HEADING

 W !!,?4,"LIST OF ALL DATES AND SHIFTS FOR WHICH",!,?4,"ASSESSMENT WAS COMPLETED FOR SELECTED PATIENTS"

 W !,?0,"================================================================================"

 W !,?53,"* ASSESSMENTS *"

 W !,?4,"NAME",?36,"UNIT",?53,"DATE",?63,"SHIFT"

 W !,?0,"--------------------------------------------------------------------------------"

 Q

COUNT ;CONTROL SCREEN DISPLAY

 I ($D(IOSL)),($Y>(IOSL-4)) D

 .D PAUSE^ANSDIC

 .D HEAD

 .W !,?4,ANSINPT,?36,ANSUNIT

 Q

ANSQPAA   ;IHS/OIRM/DSD/CSC - SETUP FOR ASSESSMENT HISTORY PRINTOUT; [ 07/07/1999  2:52 PM ]

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

 +2       ;;SETUP FOR ASSESSMENT HISTORY PRINTOUT

A1         IF '$DATA(ANSDFN)

               QUIT 

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

               QUIT 

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

 +3        DO PREP

 +4        QUIT 

PREP      ;PRINT REPORT

 +1        SET ANSINPT=ANSPT

 +2        DO NAME

 +3        QUIT 

NAME      ;PRINT PATIENT NAME

 +1       ;S ANSY=ANSADM Q:ANSY=""

 +2        SET ANSPUNIT=$PIECE(^ANSR(ANSADM,"DX"),U,2)

           SET ANSUNIT=$SELECT(ANSPUNIT]"":^ANSD(59.1,ANSPUNIT,0),1:"NOT SPECIFIED")

 +3        IF ANSINPT]""

               WRITE !,?4,ANSINPT,?36,ANSUNIT

 +4        SET ANSCA=""

 +5        FOR I=0:0

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

               IF ANSCA=""

                   QUIT 

               DO DATA

 +6        DO PAUSE^ANSDIC

 +7        QUIT 

DATA      ;PRINT DATA

 +1        DO COUNT

 +2       ;Y2000

           WRITE ?53,$EXTRACT(ANSCA,4,5)_"-"_$EXTRACT(ANSCA,6,7)_"-"_($EXTRACT(ANSCA,1,3)+1700),?65,$EXTRACT(ANSCA,9),!

 +3        QUIT 

HEAD      ;EP

 +1        SET ANSHEAD=""

 +2        DO HISTORY^ANSQ

 +3        KILL ANSHEAD

REPHEAD   ;REPORT HEADING

 +1        WRITE !!,?4,"LIST OF ALL DATES AND SHIFTS FOR WHICH",!,?4,"ASSESSMENT WAS COMPLETED FOR SELECTED PATIENTS"

 +2        WRITE !,?0,"================================================================================"

 +3        WRITE !,?53,"* ASSESSMENTS *"

 +4        WRITE !,?4,"NAME",?36,"UNIT",?53,"DATE",?63,"SHIFT"

 +5        WRITE !,?0,"--------------------------------------------------------------------------------"

 +6        QUIT 

COUNT     ;CONTROL SCREEN DISPLAY

 +1        IF ($DATA(IOSL))

               IF ($Y>(IOSL-4))

                   Begin DoDot:1

 +2                    DO PAUSE^ANSDIC

 +3                    DO HEAD

 +4                    WRITE !,?4,ANSINPT,?36,ANSUNIT

                   End DoDot:1

 +5        QUIT