ACRFTPA1.m

ACRFTPA1 ;IHS/OIRM/DSD/THL,AEF - ENTER MULTIPLE PARTICIPANTS FOR GROUP TRAINING; [ 11/01/2001   9:44 AM ]

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

 ;;UTILITY TO MANAGE GROUP TRAINING PARTICIPANTS

EN D EXIT

 D EN1

EXIT K ACR,ACRQUIT,ACROUT,ACRDA,ACRDUZ,ACRJ,ACRTP0,ACRTP,ACRMAX,ACRPAGE,ACRCANX,ACROBJO,ACRCANO,ACRLBDA,ACRCAN,ACROBJ,ACRYRO,ACRMOO,ACRFPO

 K ^TMP("ACRTP",$J)

 Q

EN1 ;

 W !!,"A 350 will now be printed for each of the participants in the selected training."

 S ZTDESC="350'S FOR TRAINING PARTICIPANTS"

 S (ACRRTN,ZTRTN)="LIST^ACRFTPA1"

 D ^ACRFZIS

 Q

LIST ;EP;TO LIST PARTICIPANTS FOR GROUP TRAINING

 S ACRTPO=$P(^ACRDOC(ACRDOCDA,"TRNG"),U,2)

 S ACRYRO=$P(^ACRDOC(ACRDOCDA,"TRNG"),U,7)

 S ACRMOO=$P(^ACRDOC(ACRDOCDA,"TRNG"),U,8)

 S ACRDA=0

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

 .S ACRTP=+$G(^ACRTPAR(ACRDA,0))

 .Q:'ACRTP

 .S DA=ACRDOCDA

 .S DIE="^ACRDOC("

 .S DR="148030////"_ACRTP

 .D EOD

 .D DIE^ACRFDIC

 .K DXS,DIP

 .S D0=ACRDOCDA

 .D ^ACRPTRG

 .W @IOF

 S DA=ACRDOCDA

 S DIE="^ACRDOC("

 S DR="148030////"_ACRTPO_";148081////"_ACRYRO_";148082////"_ACRMOO

 D DIE^ACRFDIC

 K ACRTP,ACRYRO,ACRMOO

 Q

EOD ;ENTRY ON DUTY DATE

 I $P(^ACRTPAR(ACRDA,0),U,6) S ACRYR=$P(^(0),U,6),ACRMO=$P(^(0),U,7) G EODX

EOD1 ;EP;

 Q:'$P($G(^ACRAU(+$G(ACRTP),1)),U,14)  S ACREOD=$P(^(1),U,14)

 N ACRYR,ACRMO,X,Y

 S ACRYR=ACREOD\10000+1700

 S ACRMO=+$E(ACREOD,4,5)

 S X=DT\10000+1700

 S Y=+$E(DT,4,5)

 I Y>(ACRMO-1) S ACRMO=Y-ACRMO

 E  D

 .S X=X-1

 .S ACRMO=12-ACRMO+Y

 S ACRYR=X-ACRYR

 S:ACRYR<1 ACRYR=0

EODX S DR=DR_";148081////"_ACRYR_";148082////"_ACRMO

 Q

ACRFTPA1  ;IHS/OIRM/DSD/THL,AEF - ENTER MULTIPLE PARTICIPANTS FOR GROUP TRAINING; [ 11/01/2001   9:44 AM ]

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

 +2       ;;UTILITY TO MANAGE GROUP TRAINING PARTICIPANTS

EN         DO EXIT

 +1        DO EN1

EXIT       KILL ACR,ACRQUIT,ACROUT,ACRDA,ACRDUZ,ACRJ,ACRTP0,ACRTP,ACRMAX,ACRPAGE,ACRCANX,ACROBJO,ACRCANO,ACRLBDA,ACRCAN,ACROBJ,ACRYRO,ACRMOO,ACRFPO

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

 +2        QUIT 

EN1       ;

 +1        WRITE !!,"A 350 will now be printed for each of the participants in the selected training."

 +2        SET ZTDESC="350'S FOR TRAINING PARTICIPANTS"

 +3        SET (ACRRTN,ZTRTN)="LIST^ACRFTPA1"

 +4        DO ^ACRFZIS

 +5        QUIT 

LIST      ;EP;TO LIST PARTICIPANTS FOR GROUP TRAINING

 +1        SET ACRTPO=$PIECE(^ACRDOC(ACRDOCDA,"TRNG"),U,2)

 +2        SET ACRYRO=$PIECE(^ACRDOC(ACRDOCDA,"TRNG"),U,7)

 +3        SET ACRMOO=$PIECE(^ACRDOC(ACRDOCDA,"TRNG"),U,8)

 +4        SET ACRDA=0

 +5        FOR 

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

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

                   QUIT 

               Begin DoDot:1

 +6                SET ACRTP=+$GET(^ACRTPAR(ACRDA,0))

 +7                IF 'ACRTP

                       QUIT 

 +8                SET DA=ACRDOCDA

 +9                SET DIE="^ACRDOC("

 +10               SET DR="148030////"_ACRTP

 +11               DO EOD

 +12               DO DIE^ACRFDIC

 +13               KILL DXS,DIP

 +14               SET D0=ACRDOCDA

 +15               DO ^ACRPTRG

 +16               WRITE @IOF

               End DoDot:1

 +17       SET DA=ACRDOCDA

 +18       SET DIE="^ACRDOC("

 +19       SET DR="148030////"_ACRTPO_";148081////"_ACRYRO_";148082////"_ACRMOO

 +20       DO DIE^ACRFDIC

 +21       KILL ACRTP,ACRYRO,ACRMOO

 +22       QUIT 

EOD       ;ENTRY ON DUTY DATE

 +1        IF $PIECE(^ACRTPAR(ACRDA,0),U,6)

               SET ACRYR=$PIECE(^(0),U,6)

               SET ACRMO=$PIECE(^(0),U,7)

               GOTO EODX

EOD1      ;EP;

 +1        IF '$PIECE($GET(^ACRAU(+$GET(ACRTP),1)),U,14)

               QUIT 

           SET ACREOD=$PIECE(^(1),U,14)

 +2        NEW ACRYR,ACRMO,X,Y

 +3        SET ACRYR=ACREOD\10000+1700

 +4        SET ACRMO=+$EXTRACT(ACREOD,4,5)

 +5        SET X=DT\10000+1700

 +6        SET Y=+$EXTRACT(DT,4,5)

 +7        IF Y>(ACRMO-1)

               SET ACRMO=Y-ACRMO

 +8       IF '$TEST

               Begin DoDot:1

 +9                SET X=X-1

 +10               SET ACRMO=12-ACRMO+Y

               End DoDot:1

 +11       SET ACRYR=X-ACRYR

 +12       IF ACRYR<1

               SET ACRYR=0

EODX       SET DR=DR_";148081////"_ACRYR_";148082////"_ACRMO

 +1        QUIT