ACRFTPAR.m

ACRFTPAR ;IHS/OIRM/DSD/THL,AEF - ENTER MULTIPLE PARTICIPANTS FOR GROUP TRAINING; [ 09/26/2005   9:44 AM ]

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

 ;;UTILITY TO MANAGE GROUP TRAINING PARTICIPANTS

EN N ACRLBDA,ACRCAN,ACROBJ

 D EXIT

 S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,0))

 Q:'ACRSSDA

 S ACROBJO=$P($G(^ACRSS(ACRSSDA,0)),U,4)

 S ACRCANO=$P($G(^ACRSS(ACRSSDA,0)),U,5)

 Q:'ACROBJO!'ACRCANO

 F  D EN1 Q:$D(ACRQUIT)!$D(ACROUT)

EXIT K ACR,ACRQUIT,ACROUT,ACRTPDA,ACRDUZ,ACRJ,ACRTP0,ACRTP,ACRMAX,ACRPAGE,ACRCANX,ACROBJO,ACRCANO

 K ^TMP("ACRTP",$J)

 Q

EN1 ;

 D LIST

 D SELECT

 Q

LIST ;EP;TO LIST PARTICIPANTS FOR GROUP TRAINING

 Q:$D(ACRTPALL)

 K ^TMP("ACRTP",$J),ACR,ACRCANX

 S ACRPAGE=0

 D HEAD

 S ACRTPDA=0

 F  S ACRTPDA=$O(^ACRTPAR("C",ACRDOCDA,ACRTPDA)) Q:'ACRTPDA!$D(ACRQUIT)!$D(ACROUT)  D

 .S ACRTP0=$G(^ACRTPAR(+ACRTPDA,0))

 .Q:ACRTP0=""

 .Q:'$P(ACRTP0,U,2)!'$P(ACRTP0,U,3)

 .S ACRLBDA=$P(ACRTP0,U,3)

 .S ACRCAN=$P($G(^ACRLOCB(ACRLBDA,"DT")),U,9)

 .S ACRCAN=$P($G(^AUTTCAN(+ACRCAN,0)),U)

 .;S ACRTP=$P($G(^VA(200,+ACRTP0,0)),U)  ;ACR*2.1*19.02 IM16848

 .S ACRTP=$$NAME2^ACRFUTL1(+ACRTP0)  ;ACR*2.1*19.02 IM16848

 .Q:ACRTP=""

 .S ^TMP("ACRTP",$J,ACRCAN,ACRTP)=$P(ACRTP0,U,4,5)_U_ACRTPDA

 S ACRJ=0

 S ACRCAN=""

 F  S ACRCAN=$O(^TMP("ACRTP",$J,ACRCAN)) Q:ACRCAN=""!$D(ACRQUIT)!$D(ACROUT)  D

 .S ACRTP=""

 .F  S ACRTP=$O(^TMP("ACRTP",$J,ACRCAN,ACRTP)) Q:ACRTP=""!$D(ACROUT)  S ACRTP0=^(ACRTP) D

 ..S ACRJ=ACRJ+1

 ..S ACR(ACRJ)=$P(ACRTP0,U,3)

 ..Q:$D(ACRQUIT)

 ..I ACRCAN'=$G(ACRCANX) W !,ACRCAN S ACRCANX=ACRCAN

 ..E  W !

 ..W ?9,ACRJ,?14,ACRTP

 ..D SS

 .I $Y+4>IOSL D PAUSE^ACRFWARN,HEAD

 S ACRMAX=ACRJ

 I $D(ACRTPAR) D PAUSE^ACRFWARN K ACRTPAR

 Q

SS ;LIST CHARGES FOR INDIVIDUAL PARTICIPANT

 N J,X,Y

 S J(1)=$P(ACRTP0,U)

 S J(2)=$P(ACRTP0,U,2)

 F X=1,2 I J(X),$D(^ACRSS(J(X),"DT")) S Y=$P(^("DT"),U,4) D

 .W:X=1 ?46

 .W:X=2 ?60

 .W $J($FN(Y,"P,",2),12)

 Q

SELECT ;SELECT FUNCTION

 S DIR(0)="SO^1:Add Training Participants;2:Edit a Training Participant;3:DELETE a Training Participant;4:PRINT the Training Participant List"

 S DIR("A")="Which one"

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!'$G(Y)

 I Y=1 D ADD S Y=1

 I Y=2 D EDIT S Y=2

 I Y=3 D DELETE S Y=3

 I Y=4 D PRINT S Y=4

 K ACRQUIT

 Q

ADD ;ADD PARTICIPANT TO GROUP TRAINING LIST

 F  D ADD1 Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRQUIT

 Q

ADD1 W @IOF

 W !,"Add additional participants to TRAININ REQUEST ",$P(^ACRDOC(ACRDOCDA,0),U)

 D TRAINEE

 I '$G(ACRDUZ) S ACRQUIT="" Q

 I $D(^ACRTPAR("AC",ACRDOCDA,ACRDUZ)) D A1 Q

 D ACCOUNT

 I '$G(ACRLBDA)!'$G(ACRCANDA) S ACRQUIT="" Q

 D CERTAIN

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

A1 S ACRTPDA=$O(^ACRTPAR("AC",ACRDOCDA,ACRDUZ,0))

 Q:'ACRTPDA

 D E1

 Q

TRAINEE ;SELECT TRAINEE TO ADD, EDIT OR DELETE

 K ACRDUZ

 S DIC="^ACRAU("

 S DIC(0)="AEMQZ"

 S DIC("A")="Name of TRAINEE: "

 W !

 D DIC^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!($G(Y)<1) S ACRQUIT="" Q

 S ACRDUZ=+Y

 N X

 ;S X=$P($G(^VA(200,+Y,0)),U)  ;ACR*2.1*19.02 IM16848

 S X=$$NAME2^ACRFUTL1(+Y)  ;ACR*2.1*19.02 IM16848

 S ACRTP=$P($P(X,",",2)," ")_" "_$P(X,",")

 I $P($G(^ACRDOC(ACRDOCDA,"TRNG")),U,2)=ACRDUZ D  Q

 .W !!,ACRTP," is the ATTENDEE of record for this 350"

 .W !,"and does not need to be added again."

 .K ACRDUZ

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 Q

ACCOUNT ;SELECT DEPARTMENT ACCOUNT TO WHICH TO CHARGE EXPENSES

 K ACRLBDA,ACRCANDA

 S ACRFY=$P($G(^ACRLOCB(+$P($G(^ACRDOC(+$G(ACRDOCDA),0)),U,6),"DT")),U)

 I '$D(^ACRLOCB("SEC",ACRDUZ)) D  Q

 .W !!,ACRTP," does not have access to any DEPARTMENT ACCOUNTS."

 .W !,$S($P($G(^VA(200,ACRDUZ,1)),U,2)="M":"He",$P($G(^(1)),U,2)="F":"She",1:"Attendee")

 .W " must have access to a DEPARTMENT ACCOUNT"

 .W !,"before one can be selected."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 N X

 S X=0

 F  S X=$O(^ACRLOCB("SEC",ACRDUZ,X)) Q:'X!$D(ACRQUIT)  I $P($G(^ACRLOCB(X,"DT")),U)=ACRFY S ACRQUIT=""

 I '$D(ACRQUIT) D  Q

 .W !,ACRTP," must have access to a DEPARTMENT ACCOUNT"

 .W !,"from FISCAL YEAR ",ACRFY," before one can be selected."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 E  K ACRQUIT

 S DIC="^ACRLOCB("

 S DIC(0)="AEQZ"

 S DIC("S")="I $D(^ACRLOCB(""SEC"",ACRDUZ,+Y)),$P($G(^ACRLOCB(+Y,""DT"")),U)=ACRFY"

 S D="DCAN"

 S DIC("A")="to COMMON ACCOUNTING NUMBER: "

 W !!,"Charge expenses for ",ACRTP

 D IX^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!($G(Y)<1)

 S ACRLBDA=+Y

 I '$D(^ACRLOCB("SEC",ACRDUZ,ACRLBDA)) D  Q

 .W !!,"Training Expenses for ",ACRTP

 .W !,"cannot be charged to this account."

 .D PAUSE^ACRFWARN

 .K ACRQUIT

 S ACRCANDA=$P($G(^ACRLOCB(+Y,"DT")),U,9)

 Q

CERTAIN ;CONFIRM ADDITION OF TRAINEE

 S DIR(0)="YO"

 S DIR("A")=ACRTP_" to this TRAINING REQUEST"

 S DIR("A",1)="Are you CERTAIN you want to add"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!($G(Y)'=1) S ACRQUIT="" Q

FILE ;FILE NEW ATTENDEE

 S X=ACRDUZ

 S DIC="^ACRTPAR("

 S DIC(0)="L"

 S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRLBDA

 D FILE^ACRFDIC

 S ACRTPDA=+Y

 F ACRX=1,2 D

 .S X=ACRX

 .S DIC="^ACRSS("

 .S DIC(0)="L"

 .S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACROBJO_";.05////"_ACRCANDA_";.06////"_ACRLBDA_";5////"_$S(X=1:"Tuition & Fees",1:"Books & Other")

 .D FILE^ACRFDIC

 .S DA=ACRTPDA

 .S DIE="^ACRTPAR("

 .S DR=$S(ACRX=1:".04",1:".05")_"////"_+Y

 .D DIE^ACRFDIC

 Q:$P($G(^ACRAU(ACRDUZ,1)),U,14)

 S DA=ACRTPDA

 S DIE="^ACRTPAR("

 S DR=".06T;.07T;.08T"

 D DIE^ACRFDIC

 Q

EDIT ;EDIT PARTICIPATN CURRENTLY ON GROUP TRAINING LIST

 I ACRMAX=1 S Y=1 D E0 Q

 S DIR(0)="LO^1:"_ACRMAX

 S DIR("A")="Which TRAINEE(S)"

 W !

 D DIR^ACRFDIC

E0 Q:$D(ACRQUIT)!$D(ACROUT)!(+$G(Y)<1)

 S ACRXX=Y

 N ACRJ,ACRYY

 F ACRJ=1:1 S ACRYY=$P(ACRXX,",",ACRJ) Q:'ACRYY  D

 .S ACRTPDA=ACR(ACRYY)

 .D E1

 Q

E1 S ACRTP0=$G(^ACRTPAR(+ACRTPDA,0))

 N X

 S X=+ACRTP0

 ;S X=$P($G(^VA(200,+X,0)),U)  ;ACR*2.1*19.02 IM16848

 S X=$$NAME2^ACRFUTL1(+X)  ;ACR*2.1*19.02 IM16848

 S X=$P($P(X,",",2)," ")_" "_$P(X,",")

 W !!,"Training Expenses for: ",X

 F ACRX=4,5 D

 .S DA=$P(ACRTP0,U,ACRX)

 .Q:'DA

 .S DIE="^ACRSS("

 .S DR="13"_$S(ACRX=4:"Tuition & Fees......",1:"Books & Other.......")

 .D DIE^ACRFDIC

 Q

DELETE ;DELETE PARTICIPANT FROM GROUP TRAINING LIST

 I ACRMAX=1 S ACRTPDA=ACR(1) D D1 Q

 S DIR(0)="LO^1:"_ACRMAX

 S DIR("A")="Which TRAINEE"

 W !

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!($G(Y)<1) S ACRQUIT="" Q

 S ACRXX=Y

 N ACRJ,ACRYY

 F ACRJ=1:1 S ACRYY=$P(ACRXX,",",ACRJ) Q:'ACRYY  D

 .S ACRTPDA=ACR(ACRYY)

 .D D1

 Q

D1 S ACRTP0=$G(^ACRTPAR(+ACRTPDA,0))

 N X

 S X=+ACRTP0

 ;S X=$P($G(^VA(200,+X,0)),U)  ;ACR*2.1*19.02 IM16848

 S X=$$NAME2^ACRFUTL1(+X)  ;ACR*2.1*19.02 IM16848

 S ACRTP=$P($P(X,",",2)," ")_" "_$P(X,",")

 S DIR(0)="YO"

 S DIR("A")=ACRTP_" from this TRAINING REQUEST"

 S DIR("A",1)="Are you CERTAIN you want to DELETE"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!($G(Y)'=1) K ACRQUIT Q

 F ACRX=4,5 D

 .S DA=$P(ACRTP0,U,ACRX)

 .Q:'DA

 .S DIK="^ACRSS("

 .D DIK^ACRFDIC

 S DA=ACRTPDA

 S DIK="^ACRTPAR("

 D DIK^ACRFDIC

 Q

PRINT ;EP;TO PRINT LIST OF PARTICIPANTS IN GROUP TRAINING

 S ACRTPAR=""

 I '$G(ACRDOCDA) D

 .S ACRREFX=148

 .D EN1^ACRFTO

 Q:'$G(ACRDOCDA)

 S ACRRTN="LIST^ACRFTPAR"

 S ZTRTN=ACRRTN

 S ZTDESC="PRINT TRAINING PARTICIPANT LIST FOR "_$P(^ACRDOC(ACRDOCDA,0),U)

 S ZTDTH=""

 D ^ACRFZIS

 K ACRTPAR

 Q

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

 W @IOF

 W !?9,"Training Participants for Document: ",$P(^ACRDOC(ACRDOCDA,0),U)

 W !?9,"Date List Printed: "

 S Y=DT

 X ^DD("DD")

 W Y

 W ?55,"PAGE: "

 S ACRPAGE=$G(ACRPAGE)+1

 W ACRPAGE

 W !!,"CHARGED"

 W ?46,"Tuition"

 W ?60,"Books & Other"

 W !,"TO CAN"

 W ?9,"NO."

 W ?14,"ATTENDEE"

 W ?46,"& Fees"

 W ?60,"Expenses"

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

 W ?9,"---"

 W ?14,"------------------------------"

 W ?46,"------------"

 W ?60,"------------"

 Q

YES ;EP;TO INDICATE IF TRAINING IS FOR GROUP TRAINING

 I $D(^ACRTPAR("C",ACRDOCDA)) D EN Q

 S DIR(0)="YO"

 S DIR("A",1)="Is Training request "_$P(^ACRDOC(ACRDOCDA,0),U)

 S DIR("A")="a request for GROUP TRAINING"

 S DIR("B")="NO"

 W @IOF

 W !

 D DIR^ACRFDIC

 Q:$G(Y)'=1

 D EN

 Q

ACRFTPAR  ;IHS/OIRM/DSD/THL,AEF - ENTER MULTIPLE PARTICIPANTS FOR GROUP TRAINING; [ 09/26/2005   9:44 AM ]

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

 +2       ;;UTILITY TO MANAGE GROUP TRAINING PARTICIPANTS

EN         NEW ACRLBDA,ACRCAN,ACROBJ

 +1        DO EXIT

 +2        SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,0))

 +3        IF 'ACRSSDA

               QUIT 

 +4        SET ACROBJO=$PIECE($GET(^ACRSS(ACRSSDA,0)),U,4)

 +5        SET ACRCANO=$PIECE($GET(^ACRSS(ACRSSDA,0)),U,5)

 +6        IF 'ACROBJO!'ACRCANO

               QUIT 

 +7        FOR 

               DO EN1

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

                   QUIT 

EXIT       KILL ACR,ACRQUIT,ACROUT,ACRTPDA,ACRDUZ,ACRJ,ACRTP0,ACRTP,ACRMAX,ACRPAGE,ACRCANX,ACROBJO,ACRCANO

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

 +2        QUIT 

EN1       ;

 +1        DO LIST

 +2        DO SELECT

 +3        QUIT 

LIST      ;EP;TO LIST PARTICIPANTS FOR GROUP TRAINING

 +1        IF $DATA(ACRTPALL)

               QUIT 

 +2        KILL ^TMP("ACRTP",$JOB),ACR,ACRCANX

 +3        SET ACRPAGE=0

 +4        DO HEAD

 +5        SET ACRTPDA=0

 +6        FOR 

               SET ACRTPDA=$ORDER(^ACRTPAR("C",ACRDOCDA,ACRTPDA))

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

                   QUIT 

               Begin DoDot:1

 +7                SET ACRTP0=$GET(^ACRTPAR(+ACRTPDA,0))

 +8                IF ACRTP0=""

                       QUIT 

 +9                IF '$PIECE(ACRTP0,U,2)!'$PIECE(ACRTP0,U,3)

                       QUIT 

 +10               SET ACRLBDA=$PIECE(ACRTP0,U,3)

 +11               SET ACRCAN=$PIECE($GET(^ACRLOCB(ACRLBDA,"DT")),U,9)

 +12               SET ACRCAN=$PIECE($GET(^AUTTCAN(+ACRCAN,0)),U)

 +13      ;S ACRTP=$P($G(^VA(200,+ACRTP0,0)),U)  ;ACR*2.1*19.02 IM16848

 +14      ;ACR*2.1*19.02 IM16848

                   SET ACRTP=$$NAME2^ACRFUTL1(+ACRTP0)

 +15               IF ACRTP=""

                       QUIT 

 +16               SET ^TMP("ACRTP",$JOB,ACRCAN,ACRTP)=$PIECE(ACRTP0,U,4,5)_U_ACRTPDA

               End DoDot:1

 +17       SET ACRJ=0

 +18       SET ACRCAN=""

 +19       FOR 

               SET ACRCAN=$ORDER(^TMP("ACRTP",$JOB,ACRCAN))

               IF ACRCAN=""!$DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

               Begin DoDot:1

 +20               SET ACRTP=""

 +21               FOR 

                       SET ACRTP=$ORDER(^TMP("ACRTP",$JOB,ACRCAN,ACRTP))

                       IF ACRTP=""!$DATA(ACROUT)

                           QUIT 

                       SET ACRTP0=^(ACRTP)

                       Begin DoDot:2

 +22                       SET ACRJ=ACRJ+1

 +23                       SET ACR(ACRJ)=$PIECE(ACRTP0,U,3)

 +24                       IF $DATA(ACRQUIT)

                               QUIT 

 +25                       IF ACRCAN'=$GET(ACRCANX)

                               WRITE !,ACRCAN

                               SET ACRCANX=ACRCAN

 +26                      IF '$TEST

                               WRITE !

 +27                       WRITE ?9,ACRJ,?14,ACRTP

 +28                       DO SS

                       End DoDot:2

 +29               IF $Y+4>IOSL

                       DO PAUSE^ACRFWARN

                       DO HEAD

               End DoDot:1

 +30       SET ACRMAX=ACRJ

 +31       IF $DATA(ACRTPAR)

               DO PAUSE^ACRFWARN

               KILL ACRTPAR

 +32       QUIT 

SS        ;LIST CHARGES FOR INDIVIDUAL PARTICIPANT

 +1        NEW J,X,Y

 +2        SET J(1)=$PIECE(ACRTP0,U)

 +3        SET J(2)=$PIECE(ACRTP0,U,2)

 +4        FOR X=1,2

               IF J(X)

                   IF $DATA(^ACRSS(J(X),"DT"))

                       SET Y=$PIECE(^("DT"),U,4)

                       Begin DoDot:1

 +5                        IF X=1

                               WRITE ?46

 +6                        IF X=2

                               WRITE ?60

 +7                        WRITE $JUSTIFY($FNUMBER(Y,"P,",2),12)

                       End DoDot:1

 +8        QUIT 

SELECT    ;SELECT FUNCTION

 +1        SET DIR(0)="SO^1:Add Training Participants;2:Edit a Training Participant;3:DELETE a Training Participant;4:PRINT the Training Participant List"

 +2        SET DIR("A")="Which one"

 +3        WRITE !

 +4        DO DIR^ACRFDIC

 +5        IF $DATA(ACRQUIT)!$DATA(ACROUT)!'$GET(Y)

               QUIT 

 +6        IF Y=1

               DO ADD

               SET Y=1

 +7        IF Y=2

               DO EDIT

               SET Y=2

 +8        IF Y=3

               DO DELETE

               SET Y=3

 +9        IF Y=4

               DO PRINT

               SET Y=4

 +10       KILL ACRQUIT

 +11       QUIT 

ADD       ;ADD PARTICIPANT TO GROUP TRAINING LIST

 +1        FOR 

               DO ADD1

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

                   QUIT 

 +2        KILL ACRQUIT

 +3        QUIT 

ADD1       WRITE @IOF

 +1        WRITE !,"Add additional participants to TRAININ REQUEST ",$PIECE(^ACRDOC(ACRDOCDA,0),U)

 +2        DO TRAINEE

 +3        IF '$GET(ACRDUZ)

               SET ACRQUIT=""

               QUIT 

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

               DO A1

               QUIT 

 +5        DO ACCOUNT

 +6        IF '$GET(ACRLBDA)!'$GET(ACRCANDA)

               SET ACRQUIT=""

               QUIT 

 +7        DO CERTAIN

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

               QUIT 

A1         SET ACRTPDA=$ORDER(^ACRTPAR("AC",ACRDOCDA,ACRDUZ,0))

 +1        IF 'ACRTPDA

               QUIT 

 +2        DO E1

 +3        QUIT 

TRAINEE   ;SELECT TRAINEE TO ADD, EDIT OR DELETE

 +1        KILL ACRDUZ

 +2        SET DIC="^ACRAU("

 +3        SET DIC(0)="AEMQZ"

 +4        SET DIC("A")="Name of TRAINEE: "

 +5        WRITE !

 +6        DO DIC^ACRFDIC

 +7        IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)<1)

               SET ACRQUIT=""

               QUIT 

 +8        SET ACRDUZ=+Y

 +9        NEW X

 +10      ;S X=$P($G(^VA(200,+Y,0)),U)  ;ACR*2.1*19.02 IM16848

 +11      ;ACR*2.1*19.02 IM16848

           SET X=$$NAME2^ACRFUTL1(+Y)

 +12       SET ACRTP=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")

 +13       IF $PIECE($GET(^ACRDOC(ACRDOCDA,"TRNG")),U,2)=ACRDUZ

               Begin DoDot:1

 +14               WRITE !!,ACRTP," is the ATTENDEE of record for this 350"

 +15               WRITE !,"and does not need to be added again."

 +16               KILL ACRDUZ

 +17               DO PAUSE^ACRFWARN

 +18               SET ACRQUIT=""

               End DoDot:1

               QUIT 

 +19       QUIT 

ACCOUNT   ;SELECT DEPARTMENT ACCOUNT TO WHICH TO CHARGE EXPENSES

 +1        KILL ACRLBDA,ACRCANDA

 +2        SET ACRFY=$PIECE($GET(^ACRLOCB(+$PIECE($GET(^ACRDOC(+$GET(ACRDOCDA),0)),U,6),"DT")),U)

 +3        IF '$DATA(^ACRLOCB("SEC",ACRDUZ))

               Begin DoDot:1

 +4                WRITE !!,ACRTP," does not have access to any DEPARTMENT ACCOUNTS."

 +5                WRITE !,$SELECT($PIECE($GET(^VA(200,ACRDUZ,1)),U,2)="M":"He",$PIECE($GET(^(1)),U,2)="F":"She",1:"Attendee")

 +6                WRITE " must have access to a DEPARTMENT ACCOUNT"

 +7                WRITE !,"before one can be selected."

 +8                DO PAUSE^ACRFWARN

 +9                SET ACRQUIT=""

               End DoDot:1

               QUIT 

 +10       NEW X

 +11       SET X=0

 +12       FOR 

               SET X=$ORDER(^ACRLOCB("SEC",ACRDUZ,X))

               IF 'X!$DATA(ACRQUIT)

                   QUIT 

               IF $PIECE($GET(^ACRLOCB(X,"DT")),U)=ACRFY

                   SET ACRQUIT=""

 +13       IF '$DATA(ACRQUIT)

               Begin DoDot:1

 +14               WRITE !,ACRTP," must have access to a DEPARTMENT ACCOUNT"

 +15               WRITE !,"from FISCAL YEAR ",ACRFY," before one can be selected."

 +16               DO PAUSE^ACRFWARN

 +17               SET ACRQUIT=""

               End DoDot:1

               QUIT 

 +18      IF '$TEST

               KILL ACRQUIT

 +19       SET DIC="^ACRLOCB("

 +20       SET DIC(0)="AEQZ"

 +21       SET DIC("S")="I $D(^ACRLOCB(""SEC"",ACRDUZ,+Y)),$P($G(^ACRLOCB(+Y,""DT"")),U)=ACRFY"

 +22       SET D="DCAN"

 +23       SET DIC("A")="to COMMON ACCOUNTING NUMBER: "

 +24       WRITE !!,"Charge expenses for ",ACRTP

 +25       DO IX^ACRFDIC

 +26       IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)<1)

               QUIT 

 +27       SET ACRLBDA=+Y

 +28       IF '$DATA(^ACRLOCB("SEC",ACRDUZ,ACRLBDA))

               Begin DoDot:1

 +29               WRITE !!,"Training Expenses for ",ACRTP

 +30               WRITE !,"cannot be charged to this account."

 +31               DO PAUSE^ACRFWARN

 +32               KILL ACRQUIT

               End DoDot:1

               QUIT 

 +33       SET ACRCANDA=$PIECE($GET(^ACRLOCB(+Y,"DT")),U,9)

 +34       QUIT 

CERTAIN   ;CONFIRM ADDITION OF TRAINEE

 +1        SET DIR(0)="YO"

 +2        SET DIR("A")=ACRTP_" to this TRAINING REQUEST"

 +3        SET DIR("A",1)="Are you CERTAIN you want to add"

 +4        SET DIR("B")="NO"

 +5        WRITE !

 +6        DO DIR^ACRFDIC

 +7        IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)'=1)

               SET ACRQUIT=""

               QUIT 

FILE      ;FILE NEW ATTENDEE

 +1        SET X=ACRDUZ

 +2        SET DIC="^ACRTPAR("

 +3        SET DIC(0)="L"

 +4        SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRLBDA

 +5        DO FILE^ACRFDIC

 +6        SET ACRTPDA=+Y

 +7        FOR ACRX=1,2

               Begin DoDot:1

 +8                SET X=ACRX

 +9                SET DIC="^ACRSS("

 +10               SET DIC(0)="L"

 +11               SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACROBJO_";.05////"_ACRCANDA_";.06////"_ACRLBDA_";5////"_$SELECT(X=1:"Tuition & Fees",1:"Books & Other")

 +12               DO FILE^ACRFDIC

 +13               SET DA=ACRTPDA

 +14               SET DIE="^ACRTPAR("

 +15               SET DR=$SELECT(ACRX=1:".04",1:".05")_"////"_+Y

 +16               DO DIE^ACRFDIC

               End DoDot:1

 +17       IF $PIECE($GET(^ACRAU(ACRDUZ,1)),U,14)

               QUIT 

 +18       SET DA=ACRTPDA

 +19       SET DIE="^ACRTPAR("

 +20       SET DR=".06T;.07T;.08T"

 +21       DO DIE^ACRFDIC

 +22       QUIT 

EDIT      ;EDIT PARTICIPATN CURRENTLY ON GROUP TRAINING LIST

 +1        IF ACRMAX=1

               SET Y=1

               DO E0

               QUIT 

 +2        SET DIR(0)="LO^1:"_ACRMAX

 +3        SET DIR("A")="Which TRAINEE(S)"

 +4        WRITE !

 +5        DO DIR^ACRFDIC

E0         IF $DATA(ACRQUIT)!$DATA(ACROUT)!(+$GET(Y)<1)

               QUIT 

 +1        SET ACRXX=Y

 +2        NEW ACRJ,ACRYY

 +3        FOR ACRJ=1:1

               SET ACRYY=$PIECE(ACRXX,",",ACRJ)

               IF 'ACRYY

                   QUIT 

               Begin DoDot:1

 +4                SET ACRTPDA=ACR(ACRYY)

 +5                DO E1

               End DoDot:1

 +6        QUIT 

E1         SET ACRTP0=$GET(^ACRTPAR(+ACRTPDA,0))

 +1        NEW X

 +2        SET X=+ACRTP0

 +3       ;S X=$P($G(^VA(200,+X,0)),U)  ;ACR*2.1*19.02 IM16848

 +4       ;ACR*2.1*19.02 IM16848

           SET X=$$NAME2^ACRFUTL1(+X)

 +5        SET X=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")

 +6        WRITE !!,"Training Expenses for: ",X

 +7        FOR ACRX=4,5

               Begin DoDot:1

 +8                SET DA=$PIECE(ACRTP0,U,ACRX)

 +9                IF 'DA

                       QUIT 

 +10               SET DIE="^ACRSS("

 +11               SET DR="13"_$SELECT(ACRX=4:"Tuition & Fees......",1:"Books & Other.......")

 +12               DO DIE^ACRFDIC

               End DoDot:1

 +13       QUIT 

DELETE    ;DELETE PARTICIPANT FROM GROUP TRAINING LIST

 +1        IF ACRMAX=1

               SET ACRTPDA=ACR(1)

               DO D1

               QUIT 

 +2        SET DIR(0)="LO^1:"_ACRMAX

 +3        SET DIR("A")="Which TRAINEE"

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)<1)

               SET ACRQUIT=""

               QUIT 

 +7        SET ACRXX=Y

 +8        NEW ACRJ,ACRYY

 +9        FOR ACRJ=1:1

               SET ACRYY=$PIECE(ACRXX,",",ACRJ)

               IF 'ACRYY

                   QUIT 

               Begin DoDot:1

 +10               SET ACRTPDA=ACR(ACRYY)

 +11               DO D1

               End DoDot:1

 +12       QUIT 

D1         SET ACRTP0=$GET(^ACRTPAR(+ACRTPDA,0))

 +1        NEW X

 +2        SET X=+ACRTP0

 +3       ;S X=$P($G(^VA(200,+X,0)),U)  ;ACR*2.1*19.02 IM16848

 +4       ;ACR*2.1*19.02 IM16848

           SET X=$$NAME2^ACRFUTL1(+X)

 +5        SET ACRTP=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")

 +6        SET DIR(0)="YO"

 +7        SET DIR("A")=ACRTP_" from this TRAINING REQUEST"

 +8        SET DIR("A",1)="Are you CERTAIN you want to DELETE"

 +9        SET DIR("B")="NO"

 +10       WRITE !

 +11       DO DIR^ACRFDIC

 +12       IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)'=1)

               KILL ACRQUIT

               QUIT 

 +13       FOR ACRX=4,5

               Begin DoDot:1

 +14               SET DA=$PIECE(ACRTP0,U,ACRX)

 +15               IF 'DA

                       QUIT 

 +16               SET DIK="^ACRSS("

 +17               DO DIK^ACRFDIC

               End DoDot:1

 +18       SET DA=ACRTPDA

 +19       SET DIK="^ACRTPAR("

 +20       DO DIK^ACRFDIC

 +21       QUIT 

PRINT     ;EP;TO PRINT LIST OF PARTICIPANTS IN GROUP TRAINING

 +1        SET ACRTPAR=""

 +2        IF '$GET(ACRDOCDA)

               Begin DoDot:1

 +3                SET ACRREFX=148

 +4                DO EN1^ACRFTO

               End DoDot:1

 +5        IF '$GET(ACRDOCDA)

               QUIT 

 +6        SET ACRRTN="LIST^ACRFTPAR"

 +7        SET ZTRTN=ACRRTN

 +8        SET ZTDESC="PRINT TRAINING PARTICIPANT LIST FOR "_$PIECE(^ACRDOC(ACRDOCDA,0),U)

 +9        SET ZTDTH=""

 +10       DO ^ACRFZIS

 +11       KILL ACRTPAR

 +12       QUIT 

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

               QUIT 

 +1        WRITE @IOF

 +2        WRITE !?9,"Training Participants for Document: ",$PIECE(^ACRDOC(ACRDOCDA,0),U)

 +3        WRITE !?9,"Date List Printed: "

 +4        SET Y=DT

 +5        XECUTE ^DD("DD")

 +6        WRITE Y

 +7        WRITE ?55,"PAGE: "

 +8        SET ACRPAGE=$GET(ACRPAGE)+1

 +9        WRITE ACRPAGE

 +10       WRITE !!,"CHARGED"

 +11       WRITE ?46,"Tuition"

 +12       WRITE ?60,"Books & Other"

 +13       WRITE !,"TO CAN"

 +14       WRITE ?9,"NO."

 +15       WRITE ?14,"ATTENDEE"

 +16       WRITE ?46,"& Fees"

 +17       WRITE ?60,"Expenses"

 +18       WRITE !,"-------"

 +19       WRITE ?9,"---"

 +20       WRITE ?14,"------------------------------"

 +21       WRITE ?46,"------------"

 +22       WRITE ?60,"------------"

 +23       QUIT 

YES       ;EP;TO INDICATE IF TRAINING IS FOR GROUP TRAINING

 +1        IF $DATA(^ACRTPAR("C",ACRDOCDA))

               DO EN

               QUIT 

 +2        SET DIR(0)="YO"

 +3        SET DIR("A",1)="Is Training request "_$PIECE(^ACRDOC(ACRDOCDA,0),U)

 +4        SET DIR("A")="a request for GROUP TRAINING"

 +5        SET DIR("B")="NO"

 +6        WRITE @IOF

 +7        WRITE !

 +8        DO DIR^ACRFDIC

 +9        IF $GET(Y)'=1

               QUIT 

 +10       DO EN

 +11       QUIT