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
