Routine: ACRFTR1

ACRFTR1 ;IHS/OIRM/DSD/THL,AEF - TRAINING REPORTS;  [ 11/22/2006   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,22**;NOV 05, 2001

 ;;UTILITY TO SELECT AND PRINT VARIOUS TRAINING SUMMARY REPORTS

HEAD ;EP;PRINT TRAINING SUMMARY HEADER

 W @IOF

H1 I $D(ACRSMRY) D

 .W !?3,"REPORT TYPE: "

 .N X

 .S X=ACRTYPE

 .W $S(X=1:"PURPOSE OF TRAINING",X=2:"TYPE OF TRAINING",X=3:"SOURCE OF TRAINING",X=4:"SPECIAL INTEREST CODE",X=5:"SKILL CODE",X=6:"PROFESIONAL CATEGORY",X=7:"ALL TRAINING",1:"UNSPECIFIED")

 W !!,"SUMMARY FOR...: ",ACRFOR

 S ACRDC=$S($D(ACRDC):ACRDC+1,1:1)

 W ?60,"PAGE: ",ACRDC

 W !,"REPORT DATE...: "

 S Y=DT

 X ^DD("DD")

W Y

 W !,"BEGINNING DATE: "

 S Y=ACRBEGIN

 X ^DD("DD")

W Y

 W !,"ENDING DATE...: "

 S Y=ACREND

 X ^DD("DD")

W Y

 W !,"--------------------------------------------------------------------------------"

 W !,"AUTHORIZA-"

 W ?11,"EMPLOYEE"

 W !,"TION NO."

 W ?11,"COURSE TITLE"

 W ?28,"SERIES/GRD"

 W ?41,"TUITION"

 W ?49,"BOOKS"

 W ?57,"TRAVEL"

 W ?65,"M & IE"

 W ?73,"OTHER"

 W !,"---------- ----------------------------- ------- ------- ------- ------- -------"

PL ;PRINT LINE SUMMARY OF EACH DOCUMENT

 W !,$E(ACRTGNO,1,10)

 W ?11,ACRTRNEE

 W ?32,ACRGRD

 W !?11,ACRTITLE

 W ?40,$J($P(ACR4,"."),8)

 W ?48,$J($P(ACR5,"."),8)

 W ?56,$J($P(ACR1,"."),8)

 W ?64,$J($P(ACR2,"."),8)

 W ?72,$J($P(ACR3,"."),8)

 W !?11,"HOURS: ",$J(ACRDUTHR,4),$J(ACRNDHR,5)

 W:+ACRDATES ?$X+1,ACRDATES

 W ?48,$J($P(ACR4+ACR5,"."),8)

 W ?72,$J($P(ACR1+ACR2+ACR3,"."),8)

 W $$DASH^ACRFMENU

START ;EP;TO PRINT TRAINING SUMMARY

 I ACRTYPE=8 D ALL Q

S1 K ^TMP("ACRTRNG",$J)

D H

 S ACRDOCDA=0

 ;F  S ACRDOCDA=$O(^ACRDOC(ACRXREF,ACRDFN,ACRDOCDA)) Q:'ACRDOCDA!$D(ACRQUIT)!$D(ACROUT)  I $E($G(^ACROBL(ACRDOCDA,"APV")))'="D",$P(^ACRDOC(ACRDOCDA,0),U,13)=53 S ACRDOC0=^(0) D  ;ACR*2.1*22.05 IM22816

 F  S ACRDOCDA=$O(^ACRDOC(ACRXREF,ACRDFN,ACRDOCDA)) Q:'ACRDOCDA!$D(ACRQUIT)!$D(ACROUT)  D   ;ACR*2.1*22.05 IM22816

 .Q:$E($G(^ACROBL(ACRDOCDA,"APV")))'="A"          ;ACR*2.1*22.05 IM22816

 .Q:$P(^ACRDOC(ACRDOCDA,0),U,13)'=53              ;ACR*2.1*22.05 IM22816

 .S ACRDOC0=^ACRDOC(ACRDOCDA,0)                   ;ACR*2.1*22.05 IM22816

 .I $G(ACRPOZ),$P(ACRDOC0,U,8)'=ACRPOZ  Q

 .I $G(ACRLOC),$P($G(^ACRLOCB(+$P(ACRDOC0,U,6),"DT")),U,11)'=ACRLOC Q

 .I $G(ACRAREA),$P($G(^ACRPO(+$P(ACRDOC0,U,8),0)),U,19)'=ACRAREA Q

 .I $G(ACRCAN),$P($G(^ACRDOC(ACRDOCDA,"REQ")),U,10)'=ACRCAN Q

 .S ACRTRNG=$G(^ACRDOC(ACRDOCDA,"TRNG"))

 .S ACRTRNG3=$G(^ACRDOC(ACRDOCDA,"TRNG3"))

 .S ACRTRNG4=$G(^ACRDOC(ACRDOCDA,"TRNG4"))

 . I $G(ACRSG)]"" D  Q:ACRSG'=ACRSGX

 . . S ACRSGX=$P(ACRTRNG3,U,11,12)

 . . Q:$P(ACRSGX,U)'=""&($P(ACRSGX,U,2)'="")

 . . Q:$P(ACRTRNG,U,2)=""

 . . S ACRSGX=$P($G(^ACRAU($P(ACRTRNG,U,2),1)),U,8)_U_$P($G(^ACRAU($P(ACRTRNG,U,2),1)),U,4)

 . K ACRSGX

 . I $G(ACRTT),$P(ACRTRNG3,U,7)'=ACRTT Q

 .I ACRBEGIN,ACRBEGIN>$P(ACRTRNG,U,11)!(ACREND<$P(ACRTRNG,U,12)) Q

 .I $D(ACRNVAL),$P($G(^ACROBL(ACRDOCDA,"APV")),U)="A",$D(^ACRTVAL("B",ACRDOCDA)) Q

 .D TYPET

 .S ^TMP("ACRTRNG",$J,ACRTYPET,$P(^ACRDOC(ACRDOCDA,0),U))=ACRDOCDA

 Q:'$D(^TMP("ACRTRNG",$J))

DTL S (ACRTOTD,ACRTOTND,ACRT4,ACRT5,ACRT6,ACRT1,ACRT2,ACRT3)=0

 S ACRTYPET=""

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

 .S ACRDOC=""

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

 ..S ACRDOCDA=+$G(^TMP("ACRTRNG",$J,ACRTYPET,ACRDOC))

 ..Q:'ACRDOCDA

 ..S ACRTRNG=$G(^ACRDOC(ACRDOCDA,"TRNG"))

 ..S ACRTRNG3=$G(^ACRDOC(ACRDOCDA,"TRNG3"))

 ..S ACRTRNG4=$G(^ACRDOC(ACRDOCDA,"TRNG4"))

 ..D DOCS

 I $D(ACRSMRY) D  I $D(ACRDTAIL) D PAUSE^ACRFWARN,H G DTL

 .S ACRTYPET=""

 .F  S ACRTYPET=$O(^TMP("ACRTRNG",$J,ACRTYPET)) Q:ACRTYPET=""!$D(ACRQUIT)  D STAIL

 .D TAIL

 .K ACRSMRY

 D TAIL

 D EXIT^ACRFTR:'$D(ACRXT)

 D PAUSE^ACRFWARN

 W:$E($G(IOST),1,2)="P-" @IOF

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

 E  D H1

GATHER ;GATHER DATA ON EACH TRAVEL DOCUMENT

 D EN2^ACRFCLM

N I

 F I=1:1:6 S @("ACR"_I)=$TR(@("ACR"_I)," ","")

 D TYPET

 S ACRDUZ=$P(ACRTRNG,U,2)

 S ACRDUTHR=$P(ACRTRNG,U,9)

 S ACRNDHR=$P(ACRTRNG,U,10)

 S ACRTOTD=ACRTOTD+ACRDUTHR

 S ACRTOTD(ACRTYPET)=$G(ACRTOTD(ACRTYPET))+ACRDUTHR

 S ACRTOTND=ACRTOTND+ACRNDHR

 S ACRTOTND(ACRTYPET)=$G(ACRTOTND(ACRTYPET))+ACRNDHR

 S ACRT1=ACRT1+ACR1

 S ACRT2=ACRT2+ACR2

 S ACRT3=ACRT3+ACR3

 S ACRT4=ACRT4+ACR4

 S ACRT5=ACRT5+ACR5

 S ACRT6=ACRT6+ACR6

 S ACRT1(ACRTYPET)=$G(ACRT1(ACRTYPET))+ACR1

 S ACRT2(ACRTYPET)=$G(ACRT2(ACRTYPET))+ACR2

 S ACRT3(ACRTYPET)=$G(ACRT3(ACRTYPET))+ACR3

 S ACRT4(ACRTYPET)=$G(ACRT4(ACRTYPET))+ACR4

 S ACRT5(ACRTYPET)=$G(ACRT5(ACRTYPET))+ACR5

 S ACRT6(ACRTYPET)=$G(ACRT6(ACRTYPET))+ACR6

 Q:$D(ACRSMRY)

 S ACRFROM=$P(ACRTRNG,U,11)

 S ACRTO=$P(ACRTRNG,U,12)

 S ACRTITLE=$E($P(ACRTRNG,U,18),1,29)

 S ACRTGNO=$P(^ACRDOC(ACRDOCDA,0),U)

 ;S ACRTRNEE=$E($P($G(^VA(200,+ACRDUZ,0)),U),1,20)  ;ACR*2.1*19.02 IM16848

 S ACRTRNEE=$E($$NAME2^ACRFUTL1(+ACRDUZ),1,20)  ;ACR*2.1*19.02 IM16848

 S ACRGRD=$G(^ACRAU(+ACRDUZ,1))

 S ACRGRD=$P(ACRGRD,U,3)_$P(ACRGRD,U,8)_"-"_$P(ACRGRD,U,4)

 S ACRDATES=$E(ACRFROM,4,5)_"/"_$E(ACRFROM,6,7)_"-"_$E(ACRTO,4,5)_"/"_$E(ACRTO,6,7)_"/"_$E(ACRTO,2,3)

DOCS ;GATHER AND PRINT INFO ON EACH TRAINING DOCUMENT

 D GATHER

 Q:$D(ACRSMRY)

 D PL

 D GROUP:$D(^ACRTPAR("B",ACRDOCDA))

 I $Y+5>IOSL D

 .D PAUSE^ACRFWARN

 .D HEAD

TAIL ;

 W !?18,"---- ----"

 W ?41,"------- ------- ------- ------- -------"

 W !?5,"TOTAL HOURS: ",$J(ACRTOTD,4),$J(ACRTOTND,5)

 W ?32,"DOLLARS:"

 W ?40,$J($P(ACRT4,"."),8)

 W ?48,$J($P(ACRT5,"."),8)

 W ?56,$J($P(ACRT1,"."),8)

 W ?64,$J($P(ACRT2,"."),8)

 W ?72,$J($P(ACRT3,"."),8)

 W !?30,"SUB-TOTAL:"

 W ?48,$J($P(ACRT4+ACRT5,"."),8)

 W ?72,$J($P(ACRT1+ACRT2+ACRT3,"."),8)

 W !?28,"TOTAL COSTS:"

 W ?72,$J($P(ACRT1+ACRT2+ACRT3+ACRT4+ACRT5,"."),8)

STAIL ;

 W !?5,$$TYPE(ACRTYPET,ACRTYPE("G"))

 W !?11,"HOURS: ",$J(+$G(ACRTOTD(ACRTYPET)),4),$J(+$G(ACRTOTND(ACRTYPET)),5)

 W ?32,"DOLLARS:"

 W ?40,$J($P($G(ACRT4(ACRTYPET)),"."),8)

 W ?48,$J($P($G(ACRT5(ACRTYPET)),"."),8)

 W ?56,$J($P($G(ACRT1(ACRTYPET)),"."),8)

 W ?64,$J($P($G(ACRT2(ACRTYPET)),"."),8)

 W ?72,$J($P($G(ACRT3(ACRTYPET)),"."),8)

 W !?21,"CATEGORY SUB-TOTAL:"

 W ?48,$J($P($G(ACRT4(ACRTYPET))+$G(ACRT5(ACRTYPET)),"."),8)

 W ?72,$J($P($G(ACRT1(ACRTYPET)),".")+$P($G(ACRT2(ACRTYPET)),".")+$P($G(ACRT3(ACRTYPET)),"."),8)

 W !?19,"CATEGORY TOTAL COSTS:"

 W ?72,$J($P($G(ACRT4(ACRTYPET))+$G(ACRT5(ACRTYPET))+$G(ACRT1(ACRTYPET))+$G(ACRT2(ACRTYPET))+$G(ACRT3(ACRTYPET)),"."),8)

 I $Y+5>IOSL D

 .D PAUSE^ACRFWARN

 .D HEAD

GROUP ;INCLUDE GROUP TRAINING PARTICIPANTS IN TRAINING REPORT

TYPE(X,Y) ;DETERMINE NAME TO PRINT

 I X=999 S X=$S(ACRTYPE=7:"ALL",1:"OTHER")_" TRAINING" Q X

 S X=$G(@(Y_X_",0)"))

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

Q X

ALL ;PRINT ALL SUMMARY REPORTS

 N ACRXT

 F ACRXT=1:1:7 D:'$D(ACRQUIT)&'$D(ACROUT)

 .S ACRSMRY=""

 .S ACRTYPE=ACRXT

 .Q:ACRTYPE=7

 .S ACRTYPE("G")=$$TTYPE^ACRFTR(ACRTYPE)

 .D S1

TYPET S ACRTYPET=$S(ACRTYPE=7:999,ACRTYPE=6:$P(ACRTRNG4,U,14),ACRTYPE=5:$P(ACRTRNG,U,22),ACRTYPE=6:$P(ACRTRNG4,U,14),1:$P(ACRTRNG3,U,$S(ACRTYPE=1:6,ACRTYPE=2:7,ACRTYPE=3:8,ACRTYPE=4:9,1:999)))

 S:ACRTYPET="" ACRTYPET=999

ACRFTR1   ;IHS/OIRM/DSD/THL,AEF - TRAINING REPORTS;  [ 11/22/2006   9:44 AM ]

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

 +2       ;;UTILITY TO SELECT AND PRINT VARIOUS TRAINING SUMMARY REPORTS

HEAD      ;EP;PRINT TRAINING SUMMARY HEADER

 +1        WRITE @IOF

H1         IF $DATA(ACRSMRY)

               Begin DoDot:1

 +1                WRITE !?3,"REPORT TYPE: "

 +2                NEW X

 +3                SET X=ACRTYPE

 +4                WRITE $SELECT(X=1:"PURPOSE OF TRAINING",X=2:"TYPE OF TRAINING",X=3:"SOURCE OF TRAINING",X=4:"SPECIAL INTEREST CODE",X=5:"SKILL CODE",X=6:"PROFESIONAL CATEGORY",X=7:"ALL TRAINING",1:"UNSPECIFIED")

               End DoDot:1

 +5        WRITE !!,"SUMMARY FOR...: ",ACRFOR

 +6        SET ACRDC=$SELECT($DATA(ACRDC):ACRDC+1,1:1)

 +7        WRITE ?60,"PAGE: ",ACRDC

 +8        WRITE !,"REPORT DATE...: "

 +9        SET Y=DT

 +10       XECUTE ^DD("DD")

 +11       WRITE Y

 +12       WRITE !,"BEGINNING DATE: "

 +13       SET Y=ACRBEGIN

 +14       XECUTE ^DD("DD")

 +15       WRITE Y

 +16       WRITE !,"ENDING DATE...: "

 +17       SET Y=ACREND

 +18       XECUTE ^DD("DD")

 +19       WRITE Y

 +20       WRITE !,"--------------------------------------------------------------------------------"

 +21       WRITE !,"AUTHORIZA-"

 +22       WRITE ?11,"EMPLOYEE"

 +23       WRITE !,"TION NO."

 +24       WRITE ?11,"COURSE TITLE"

 +25       WRITE ?28,"SERIES/GRD"

 +26       WRITE ?41,"TUITION"

 +27       WRITE ?49,"BOOKS"

 +28       WRITE ?57,"TRAVEL"

 +29       WRITE ?65,"M & IE"

 +30       WRITE ?73,"OTHER"

 +31       WRITE !,"---------- ----------------------------- ------- ------- ------- ------- -------"

 +32       QUIT

PL        ;PRINT LINE SUMMARY OF EACH DOCUMENT

 +1        WRITE !,$EXTRACT(ACRTGNO,1,10)

 +2        WRITE ?11,ACRTRNEE

 +3        WRITE ?32,ACRGRD

 +4        WRITE !?11,ACRTITLE

 +5        WRITE ?40,$JUSTIFY($PIECE(ACR4,"."),8)

 +6        WRITE ?48,$JUSTIFY($PIECE(ACR5,"."),8)

 +7        WRITE ?56,$JUSTIFY($PIECE(ACR1,"."),8)

 +8        WRITE ?64,$JUSTIFY($PIECE(ACR2,"."),8)

 +9        WRITE ?72,$JUSTIFY($PIECE(ACR3,"."),8)

 +10       WRITE !?11,"HOURS: ",$JUSTIFY(ACRDUTHR,4),$JUSTIFY(ACRNDHR,5)

 +11       IF +ACRDATES

               WRITE ?$X+1,ACRDATES

 +12       WRITE ?48,$JUSTIFY($PIECE(ACR4+ACR5,"."),8)

 +13       WRITE ?72,$JUSTIFY($PIECE(ACR1+ACR2+ACR3,"."),8)

 +14       WRITE $$DASH^ACRFMENU

 +15       QUIT

START     ;EP;TO PRINT TRAINING SUMMARY

 +1        IF ACRTYPE=8

               DO ALL

               QUIT

S1         KILL ^TMP("ACRTRNG",$JOB)

 +1        DO H

 +2        SET ACRDOCDA=0

 +3       ;F  S ACRDOCDA=$O(^ACRDOC(ACRXREF,ACRDFN,ACRDOCDA)) Q:'ACRDOCDA!$D(ACRQUIT)!$D(ACROUT)  I $E($G(^ACROBL(ACRDOCDA,"APV")))'="D",$P(^ACRDOC(ACRDOCDA,0),U,13)=53 S ACRDOC0=^(0) D  ;ACR*2.1*22.05 IM22816

 +4       ;ACR*2.1*22.05 IM22816

FOR

               SET ACRDOCDA=$ORDER(^ACRDOC(ACRXREF,ACRDFN,ACRDOCDA))

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

                   QUIT

               Begin DoDot:1

 +5       ;ACR*2.1*22.05 IM22816

                   IF $EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))'="A"

                       QUIT

 +6       ;ACR*2.1*22.05 IM22816

                   IF $PIECE(^ACRDOC(ACRDOCDA,0),U,13)'=53

                       QUIT

 +7       ;ACR*2.1*22.05 IM22816

                   SET ACRDOC0=^ACRDOC(ACRDOCDA,0)

 +8                IF $GET(ACRPOZ)

                       IF $PIECE(ACRDOC0,U,8)'=ACRPOZ

                           QUIT

 +9                IF $GET(ACRLOC)

                       IF $PIECE($GET(^ACRLOCB(+$PIECE(ACRDOC0,U,6),"DT")),U,11)'=ACRLOC

                           QUIT

 +10               IF $GET(ACRAREA)

                       IF $PIECE($GET(^ACRPO(+$PIECE(ACRDOC0,U,8),0)),U,19)'=ACRAREA

                           QUIT

 +11               IF $GET(ACRCAN)

                       IF $PIECE($GET(^ACRDOC(ACRDOCDA,"REQ")),U,10)'=ACRCAN

                           QUIT

 +12               SET ACRTRNG=$GET(^ACRDOC(ACRDOCDA,"TRNG"))

 +13               SET ACRTRNG3=$GET(^ACRDOC(ACRDOCDA,"TRNG3"))

 +14               SET ACRTRNG4=$GET(^ACRDOC(ACRDOCDA,"TRNG4"))

 +15               IF $GET(ACRSG)]""

                       Begin DoDot:2

 +16                       SET ACRSGX=$PIECE(ACRTRNG3,U,11,12)

 +17                       IF $PIECE(ACRSGX,U)'=""&($PIECE(ACRSGX,U,2)'="")

                               QUIT

 +18                       IF $PIECE(ACRTRNG,U,2)=""

                               QUIT

 +19                       SET ACRSGX=$PIECE($GET(^ACRAU($PIECE(ACRTRNG,U,2),1)),U,8)_U_$PIECE($GET(^ACRAU($PIECE(ACRTRNG,U,2),1)),U,4)

                       End DoDot:2

                       IF ACRSG'=ACRSGX

                           QUIT

 +20               KILL ACRSGX

 +21               IF $GET(ACRTT)

                       IF $PIECE(ACRTRNG3,U,7)'=ACRTT

                           QUIT

 +22               IF ACRBEGIN

                       IF ACRBEGIN>$PIECE(ACRTRNG,U,11)!(ACREND<$PIECE(ACRTRNG,U,12))

                           QUIT

 +23               IF $DATA(ACRNVAL)

                       IF $PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)="A"

                           IF $DATA(^ACRTVAL("B",ACRDOCDA))

                               QUIT

 +24               DO TYPET

 +25               SET ^TMP("ACRTRNG",$JOB,ACRTYPET,$PIECE(^ACRDOC(ACRDOCDA,0),U))=ACRDOCDA

               End DoDot:1

 +26       IF '$DATA(^TMP("ACRTRNG",$JOB))

               QUIT

DTL        SET (ACRTOTD,ACRTOTND,ACRT4,ACRT5,ACRT6,ACRT1,ACRT2,ACRT3)=0

 +1        SET ACRTYPET=""

 +2        FOR

               SET ACRTYPET=$ORDER(^TMP("ACRTRNG",$JOB,ACRTYPET))

               IF ACRTYPET=""!$DATA(ACRQUIT)

                   QUIT

               Begin DoDot:1

 +3                SET ACRDOC=""

 +4                FOR

                       SET ACRDOC=$ORDER(^TMP("ACRTRNG",$JOB,ACRTYPET,ACRDOC))

                       IF ACRDOC=""!$DATA(ACRQUIT)

                           QUIT

                       Begin DoDot:2

 +5                        SET ACRDOCDA=+$GET(^TMP("ACRTRNG",$JOB,ACRTYPET,ACRDOC))

 +6                        IF 'ACRDOCDA

                               QUIT

 +7                        SET ACRTRNG=$GET(^ACRDOC(ACRDOCDA,"TRNG"))

 +8                        SET ACRTRNG3=$GET(^ACRDOC(ACRDOCDA,"TRNG3"))

 +9                        SET ACRTRNG4=$GET(^ACRDOC(ACRDOCDA,"TRNG4"))

 +10                       DO DOCS

                       End DoDot:2

               End DoDot:1

 +11       IF $DATA(ACRSMRY)

               Begin DoDot:1

 +12               SET ACRTYPET=""

 +13               FOR

                       SET ACRTYPET=$ORDER(^TMP("ACRTRNG",$JOB,ACRTYPET))

                       IF ACRTYPET=""!$DATA(ACRQUIT)

                           QUIT

                       DO STAIL

 +14               DO TAIL

 +15               KILL ACRSMRY

               End DoDot:1

               IF $DATA(ACRDTAIL)

                   DO PAUSE^ACRFWARN

                   DO H

                   GOTO DTL

 +16       DO TAIL

 +17       IF '$DATA(ACRXT)

               DO EXIT^ACRFTR

 +18       DO PAUSE^ACRFWARN

 +19       IF $EXTRACT($GET(IOST),1,2)="P-"

               WRITE @IOF

 +20       QUIT

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

               DO HEAD

               IF 1

 +1       IF '$TEST

               DO H1

 +2        QUIT

GATHER    ;GATHER DATA ON EACH TRAVEL DOCUMENT

 +1        DO EN2^ACRFCLM

 +2        NEW I

 +3        FOR I=1:1:6

               SET @("ACR"_I)=$TRANSLATE(@("ACR"_I)," ","")

 +4        DO TYPET

 +5        SET ACRDUZ=$PIECE(ACRTRNG,U,2)

 +6        SET ACRDUTHR=$PIECE(ACRTRNG,U,9)

 +7        SET ACRNDHR=$PIECE(ACRTRNG,U,10)

 +8        SET ACRTOTD=ACRTOTD+ACRDUTHR

 +9        SET ACRTOTD(ACRTYPET)=$GET(ACRTOTD(ACRTYPET))+ACRDUTHR

 +10       SET ACRTOTND=ACRTOTND+ACRNDHR

 +11       SET ACRTOTND(ACRTYPET)=$GET(ACRTOTND(ACRTYPET))+ACRNDHR

 +12       SET ACRT1=ACRT1+ACR1

 +13       SET ACRT2=ACRT2+ACR2

 +14       SET ACRT3=ACRT3+ACR3

 +15       SET ACRT4=ACRT4+ACR4

 +16       SET ACRT5=ACRT5+ACR5

 +17       SET ACRT6=ACRT6+ACR6

 +18       SET ACRT1(ACRTYPET)=$GET(ACRT1(ACRTYPET))+ACR1

 +19       SET ACRT2(ACRTYPET)=$GET(ACRT2(ACRTYPET))+ACR2

 +20       SET ACRT3(ACRTYPET)=$GET(ACRT3(ACRTYPET))+ACR3

 +21       SET ACRT4(ACRTYPET)=$GET(ACRT4(ACRTYPET))+ACR4

 +22       SET ACRT5(ACRTYPET)=$GET(ACRT5(ACRTYPET))+ACR5

 +23       SET ACRT6(ACRTYPET)=$GET(ACRT6(ACRTYPET))+ACR6

 +24       IF $DATA(ACRSMRY)

               QUIT

 +25       SET ACRFROM=$PIECE(ACRTRNG,U,11)

 +26       SET ACRTO=$PIECE(ACRTRNG,U,12)

 +27       SET ACRTITLE=$EXTRACT($PIECE(ACRTRNG,U,18),1,29)

 +28       SET ACRTGNO=$PIECE(^ACRDOC(ACRDOCDA,0),U)

 +29      ;S ACRTRNEE=$E($P($G(^VA(200,+ACRDUZ,0)),U),1,20)  ;ACR*2.1*19.02 IM16848

 +30      ;ACR*2.1*19.02 IM16848

           SET ACRTRNEE=$EXTRACT($$NAME2^ACRFUTL1(+ACRDUZ),1,20)

 +31       SET ACRGRD=$GET(^ACRAU(+ACRDUZ,1))

 +32       SET ACRGRD=$PIECE(ACRGRD,U,3)_$PIECE(ACRGRD,U,8)_"-"_$PIECE(ACRGRD,U,4)

 +33       SET ACRDATES=$EXTRACT(ACRFROM,4,5)_"/"_$EXTRACT(ACRFROM,6,7)_"-"_$EXTRACT(ACRTO,4,5)_"/"_$EXTRACT(ACRTO,6,7)_"/"_$EXTRACT(ACRTO,2,3)

 +34       QUIT

DOCS      ;GATHER AND PRINT INFO ON EACH TRAINING DOCUMENT

 +1        DO GATHER

 +2        IF $DATA(ACRSMRY)

               QUIT

 +3        DO PL

 +4        IF $DATA(^ACRTPAR("B",ACRDOCDA))

               DO GROUP

 +5        IF $Y+5>IOSL

               Begin DoDot:1

 +6                DO PAUSE^ACRFWARN

 +7                DO HEAD

               End DoDot:1

 +8        QUIT

TAIL      ;

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

 +2        WRITE ?41,"------- ------- ------- ------- -------"

 +3        WRITE !?5,"TOTAL HOURS: ",$JUSTIFY(ACRTOTD,4),$JUSTIFY(ACRTOTND,5)

 +4        WRITE ?32,"DOLLARS:"

 +5        WRITE ?40,$JUSTIFY($PIECE(ACRT4,"."),8)

 +6        WRITE ?48,$JUSTIFY($PIECE(ACRT5,"."),8)

 +7        WRITE ?56,$JUSTIFY($PIECE(ACRT1,"."),8)

 +8        WRITE ?64,$JUSTIFY($PIECE(ACRT2,"."),8)

 +9        WRITE ?72,$JUSTIFY($PIECE(ACRT3,"."),8)

 +10       WRITE !?30,"SUB-TOTAL:"

 +11       WRITE ?48,$JUSTIFY($PIECE(ACRT4+ACRT5,"."),8)

 +12       WRITE ?72,$JUSTIFY($PIECE(ACRT1+ACRT2+ACRT3,"."),8)

 +13       WRITE !?28,"TOTAL COSTS:"

 +14       WRITE ?72,$JUSTIFY($PIECE(ACRT1+ACRT2+ACRT3+ACRT4+ACRT5,"."),8)

 +15       QUIT

STAIL     ;

 +1        WRITE !?5,$$TYPE(ACRTYPET,ACRTYPE("G"))

 +2        WRITE !?11,"HOURS: ",$JUSTIFY(+$GET(ACRTOTD(ACRTYPET)),4),$JUSTIFY(+$GET(ACRTOTND(ACRTYPET)),5)

 +3        WRITE ?32,"DOLLARS:"

 +4        WRITE ?40,$JUSTIFY($PIECE($GET(ACRT4(ACRTYPET)),"."),8)

 +5        WRITE ?48,$JUSTIFY($PIECE($GET(ACRT5(ACRTYPET)),"."),8)

 +6        WRITE ?56,$JUSTIFY($PIECE($GET(ACRT1(ACRTYPET)),"."),8)

 +7        WRITE ?64,$JUSTIFY($PIECE($GET(ACRT2(ACRTYPET)),"."),8)

 +8        WRITE ?72,$JUSTIFY($PIECE($GET(ACRT3(ACRTYPET)),"."),8)

 +9        WRITE !?21,"CATEGORY SUB-TOTAL:"

 +10       WRITE ?48,$JUSTIFY($PIECE($GET(ACRT4(ACRTYPET))+$GET(ACRT5(ACRTYPET)),"."),8)

 +11       WRITE ?72,$JUSTIFY($PIECE($GET(ACRT1(ACRTYPET)),".")+$PIECE($GET(ACRT2(ACRTYPET)),".")+$PIECE($GET(ACRT3(ACRTYPET)),"."),8)

 +12       WRITE !?19,"CATEGORY TOTAL COSTS:"

 +13       WRITE ?72,$JUSTIFY($PIECE($GET(ACRT4(ACRTYPET))+$GET(ACRT5(ACRTYPET))+$GET(ACRT1(ACRTYPET))+$GET(ACRT2(ACRTYPET))+$GET(ACRT3(ACRTYPET)),"."),8)

 +14       IF $Y+5>IOSL

               Begin DoDot:1

 +15               DO PAUSE^ACRFWARN

 +16               DO HEAD

               End DoDot:1

 +17       QUIT

GROUP     ;INCLUDE GROUP TRAINING PARTICIPANTS IN TRAINING REPORT

 +1        QUIT

TYPE(X,Y) ;DETERMINE NAME TO PRINT

 +1        IF X=999

               SET X=$SELECT(ACRTYPE=7:"ALL",1:"OTHER")_" TRAINING"

               QUIT X

 +2        SET X=$GET(@(Y_X_",0)"))

 +3        SET X=$PIECE(X,U,2)

 +4        QUIT X

ALL       ;PRINT ALL SUMMARY REPORTS

 +1        NEW ACRXT

 +2        FOR ACRXT=1:1:7

               IF '$DATA(ACRQUIT)&'$DATA(ACROUT)

                   Begin DoDot:1

 +3                    SET ACRSMRY=""

 +4                    SET ACRTYPE=ACRXT

 +5                    IF ACRTYPE=7

                           QUIT

 +6                    SET ACRTYPE("G")=$$TTYPE^ACRFTR(ACRTYPE)

 +7                    DO S1

                   End DoDot:1

 +8        QUIT

TYPET      SET ACRTYPET=$SELECT(ACRTYPE=7:999,ACRTYPE=6:$PIECE(ACRTRNG4,U,14),ACRTYPE=5:$PIECE(ACRTRNG,U,22),ACRTYPE=6:$PIECE(ACRTRNG4,U,14),1:$PIECE(ACRTRNG3,U,$SELECT(ACRTYPE=1:6,ACRTYPE=2:7,ACRTYPE=3:8,ACRTYPE=4:9,1:999)))

 +1        IF ACRTYPET=""

               SET ACRTYPET=999

 +2        QUIT

ACRFTR1.m