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
