ACRFDHR4.m

ACRFDHR4 ;IHS/OIRM/DSD/THL,AEF - DHR REPORTS;  [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;PRINT DHR REPORTS

 Q

ACCRUAL ;EP;TO LIST ACCRUAL DHR'S

 D AEXIT

 D A1 Q:$D(ACRQUIT)!$D(ACROUT)

AEXIT K ACRQUIT,ACROUT,ACRDC

 K ^TMP("ACRACCRU",$J)

 Q

A1 W !!,"List ACCRUAL DHR's created between:"

 D ^ACRFDATE

 I '$G(ACRBEGIN)!'$G(ACREND) D  Q

 .W !!,"Both the BEGINNING and ENDING dates are required for this inquiry."

 .D PAUSE^ACRFWARN

 S (ACRRTN,ZTRTN)="APRINT^ACRFDHR4"

 S ZTDESC="ACCRUAL DHR SUMMARY"

 D ZIS

 Q

ZIS ;SELECT PRINTER

 D ^ACRFZIS

 Q

APRINT ;EP;TO PRINT ACCRUAL DHR SUMMARY

 I $E(IOST,1,2)="C-" D

 .W !!,"Please stand by."

 .W !,"It could take me a while to find all the ACCRUAL DHR's."

 N X,Y

 S ACRDATE=ACRBEGIN

 F  S ACRDATE=$O(^ACRDHR("D",ACRDATE)) Q:'ACRDATE!(ACRDATE>ACREND)  D

 .S ACRDHRDA=0

 .F  S ACRDHRDA=$O(^ACRDHR("D",ACRDATE,ACRDHRDA)) Q:'ACRDHRDA  I $P($G(^ACRDHR(ACRDHRDA,1)),U,3)]"","081091"[$P(^(1),U,3) S X=^(1),Y=$G(^(10)) D

 ..Q:$P(X,U,7)=""

 ..S ACRSSA=$S($P(Y,U,2)="":"NOT STATED",1:$P(Y,U,2))

 ..S ^TMP("ACRACCRU",$J,ACRSSA,$P(X,U,7),ACRDHRDA)=""

 I '$D(^TMP("ACRACCRU",$J)) D  Q

 .W !!,"NO ACCRUAL DHR'S ON FILE FOR SPECIFIED TIME PERIOD"

 .D PAUSE^ACRFWARN

 D AHEAD

 N ACRSSA,ACRSSAX,ACRTOT,ACRTTOT,ACRDOC,ACRDHRDA

 S (ACRSSA,ACRSSAX,ACRTOT,ACRTTOT)=""

 F  S ACRSSA=$O(^TMP("ACRACCRU",$J,ACRSSA)) Q:ACRSSA=""!$D(ACRQUIT)  D

 .I ACRSSA'=ACRSSAX D

 ..I ACRTOT D ATOT

 ..W !!?10,"SUB-SUB-ACTIVITY: ",ACRSSA

 ..S ACRSSAX=ACRSSA

 .S ACRDOC=""

 .F  S ACRDOC=$O(^TMP("ACRACCRU",$J,ACRSSA,ACRDOC)) Q:ACRDOC=""!$D(ACRQUIT)  D

 ..S ACRDHRDA=0

 ..F  S ACRDHRDA=$O(^TMP("ACRACCRU",$J,ACRSSA,ACRDOC,ACRDHRDA)) Q:'ACRDHRDA!$D(ACRQUIT)  D AP1

 F ACRTOT=ACRTOT,ACRTTOT D ATOT

 D PAUSE^ACRFWARN

 Q

ATOT ;

 W !?37,"---------------"

 W !?37,$J($FN(ACRTOT,"P,",2),14)

 S ACRTOT=0

 Q

AP1 ;PRINT EACH HDR SUMMARY

 N ACRX,X

 S ACRX=$G(^ACRDHR(ACRDHRDA,1))

 Q:ACRX=""

 S X=$P(ACRX,U,2)

 W !,$E(X,4,7),$E(X,2,3),?7,$P(ACRX,U,7),?18,$P(ACRX,U,3),$P(ACRX,U,4),$P(ACRX,U,5),?24,$P(ACRX,U,12),?32,$P(ACRX,U,13),?37,$J($FN($P(ACRX,U,14)/100,"P,",2),14)

 S ACRTOT=ACRTOT+($P(ACRX,U,14)/100)

 S ACRTTOT=ACRTTOT+($P(ACRX,U,14)/100)

 I IOSL-4<$Y D PAUSE^ACRFWARN Q:$D(ACRQUIT)  D AHEAD

 Q

AHEAD ;PRINT REPORT HEADER

 W @IOF

 W !?10,"ACCRUAL DHR SUMMARY"

 W !?10,"FOR ACCRUALS FROM: "

 S Y=ACRBEGIN

 X ^DD("DD")

 W Y

 S ACRDC=$G(ACRDC)+1

 W ?55,"PAGE: ",ACRDC

 W !?10,"FOR ACCRUALS TO..: "

 S Y=ACREND

 X ^DD("DD")

 W Y

 W !?10,"REPORT DATE......: "

 S Y=DT

 X ^DD("DD")

 W Y

 W $$DASH^ACRFMENU

 W !,"EFFECT",?7,"DOCUMENT",?18,"TRANS",?32,"OBJ"

 W !,"DATE",?7,"NUMBER",?18,"CODE",?24,"CAN",?32,"CODE",?40,"AMOUNT"

 W $$DASH^ACRFMENU

 Q

ACRFDHR4  ;IHS/OIRM/DSD/THL,AEF - DHR REPORTS;  [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;PRINT DHR REPORTS

 +3        QUIT 

ACCRUAL   ;EP;TO LIST ACCRUAL DHR'S

 +1        DO AEXIT

 +2        DO A1

           IF $DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT 

AEXIT      KILL ACRQUIT,ACROUT,ACRDC

 +1        KILL ^TMP("ACRACCRU",$JOB)

 +2        QUIT 

A1         WRITE !!,"List ACCRUAL DHR's created between:"

 +1        DO ^ACRFDATE

 +2        IF '$GET(ACRBEGIN)!'$GET(ACREND)

               Begin DoDot:1

 +3                WRITE !!,"Both the BEGINNING and ENDING dates are required for this inquiry."

 +4                DO PAUSE^ACRFWARN

               End DoDot:1

               QUIT 

 +5        SET (ACRRTN,ZTRTN)="APRINT^ACRFDHR4"

 +6        SET ZTDESC="ACCRUAL DHR SUMMARY"

 +7        DO ZIS

 +8        QUIT 

ZIS       ;SELECT PRINTER

 +1        DO ^ACRFZIS

 +2        QUIT 

APRINT    ;EP;TO PRINT ACCRUAL DHR SUMMARY

 +1        IF $EXTRACT(IOST,1,2)="C-"

               Begin DoDot:1

 +2                WRITE !!,"Please stand by."

 +3                WRITE !,"It could take me a while to find all the ACCRUAL DHR's."

               End DoDot:1

 +4        NEW X,Y

 +5        SET ACRDATE=ACRBEGIN

 +6        FOR 

               SET ACRDATE=$ORDER(^ACRDHR("D",ACRDATE))

               IF 'ACRDATE!(ACRDATE>ACREND)

                   QUIT 

               Begin DoDot:1

 +7                SET ACRDHRDA=0

 +8                FOR 

                       SET ACRDHRDA=$ORDER(^ACRDHR("D",ACRDATE,ACRDHRDA))

                       IF 'ACRDHRDA

                           QUIT 

                       IF $PIECE($GET(^ACRDHR(ACRDHRDA,1)),U,3)]""

                           IF "081091"[$PIECE(^(1),U,3)

                               SET X=^(1)

                               SET Y=$GET(^(10))

                               Begin DoDot:2

 +9                                IF $PIECE(X,U,7)=""

                                       QUIT 

 +10                               SET ACRSSA=$SELECT($PIECE(Y,U,2)="":"NOT STATED",1:$PIECE(Y,U,2))

 +11                               SET ^TMP("ACRACCRU",$JOB,ACRSSA,$PIECE(X,U,7),ACRDHRDA)=""

                               End DoDot:2

               End DoDot:1

 +12       IF '$DATA(^TMP("ACRACCRU",$JOB))

               Begin DoDot:1

 +13               WRITE !!,"NO ACCRUAL DHR'S ON FILE FOR SPECIFIED TIME PERIOD"

 +14               DO PAUSE^ACRFWARN

               End DoDot:1

               QUIT 

 +15       DO AHEAD

 +16       NEW ACRSSA,ACRSSAX,ACRTOT,ACRTTOT,ACRDOC,ACRDHRDA

 +17       SET (ACRSSA,ACRSSAX,ACRTOT,ACRTTOT)=""

 +18       FOR 

               SET ACRSSA=$ORDER(^TMP("ACRACCRU",$JOB,ACRSSA))

               IF ACRSSA=""!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +19               IF ACRSSA'=ACRSSAX

                       Begin DoDot:2

 +20                       IF ACRTOT

                               DO ATOT

 +21                       WRITE !!?10,"SUB-SUB-ACTIVITY: ",ACRSSA

 +22                       SET ACRSSAX=ACRSSA

                       End DoDot:2

 +23               SET ACRDOC=""

 +24               FOR 

                       SET ACRDOC=$ORDER(^TMP("ACRACCRU",$JOB,ACRSSA,ACRDOC))

                       IF ACRDOC=""!$DATA(ACRQUIT)

                           QUIT 

                       Begin DoDot:2

 +25                       SET ACRDHRDA=0

 +26                       FOR 

                               SET ACRDHRDA=$ORDER(^TMP("ACRACCRU",$JOB,ACRSSA,ACRDOC,ACRDHRDA))

                               IF 'ACRDHRDA!$DATA(ACRQUIT)

                                   QUIT 

                               DO AP1

                       End DoDot:2

               End DoDot:1

 +27       FOR ACRTOT=ACRTOT,ACRTTOT

               DO ATOT

 +28       DO PAUSE^ACRFWARN

 +29       QUIT 

ATOT      ;

 +1        WRITE !?37,"---------------"

 +2        WRITE !?37,$JUSTIFY($FNUMBER(ACRTOT,"P,",2),14)

 +3        SET ACRTOT=0

 +4        QUIT 

AP1       ;PRINT EACH HDR SUMMARY

 +1        NEW ACRX,X

 +2        SET ACRX=$GET(^ACRDHR(ACRDHRDA,1))

 +3        IF ACRX=""

               QUIT 

 +4        SET X=$PIECE(ACRX,U,2)

 +5        WRITE !,$EXTRACT(X,4,7),$EXTRACT(X,2,3),?7,$PIECE(ACRX,U,7),?18,$PIECE(ACRX,U,3),$PIECE(ACRX,U,4),$PIECE(ACRX,U,5),?24,$PIECE(ACRX,U,12),?32,$PIECE(ACRX,U,13),?37,$JUSTIFY($FNUMBER($PIECE(ACRX,U,14)/100,"P,",2),14)

 +6        SET ACRTOT=ACRTOT+($PIECE(ACRX,U,14)/100)

 +7        SET ACRTTOT=ACRTTOT+($PIECE(ACRX,U,14)/100)

 +8        IF IOSL-4<$Y

               DO PAUSE^ACRFWARN

               IF $DATA(ACRQUIT)

                   QUIT 

               DO AHEAD

 +9        QUIT 

AHEAD     ;PRINT REPORT HEADER

 +1        WRITE @IOF

 +2        WRITE !?10,"ACCRUAL DHR SUMMARY"

 +3        WRITE !?10,"FOR ACCRUALS FROM: "

 +4        SET Y=ACRBEGIN

 +5        XECUTE ^DD("DD")

 +6        WRITE Y

 +7        SET ACRDC=$GET(ACRDC)+1

 +8        WRITE ?55,"PAGE: ",ACRDC

 +9        WRITE !?10,"FOR ACCRUALS TO..: "

 +10       SET Y=ACREND

 +11       XECUTE ^DD("DD")

 +12       WRITE Y

 +13       WRITE !?10,"REPORT DATE......: "

 +14       SET Y=DT

 +15       XECUTE ^DD("DD")

 +16       WRITE Y

 +17       WRITE $$DASH^ACRFMENU

 +18       WRITE !,"EFFECT",?7,"DOCUMENT",?18,"TRANS",?32,"OBJ"

 +19       WRITE !,"DATE",?7,"NUMBER",?18,"CODE",?24,"CAN",?32,"CODE",?40,"AMOUNT"

 +20       WRITE $$DASH^ACRFMENU

 +21       QUIT