PRSEPMC ;HISC/DAD-EMPLOYEE MANDATORY TRAINING GROUP/CLASS REPORT ;4/24/1998
;;4.0;PAID;**41**;Sep 21, 1995
EN1 ; ENTRY POINT FROM OPTION
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
D EN2^PRSEUTL3($G(DUZ))
I PRSESER'>0,'(DUZ(0)="@") D MSG3^PRSEMSG G EXIT
S PSPC=PRSESER,PSPC("TX")=PRSESER("TX")
SEL K Y S DIR(0)="SO^M:Mandatory Training Group/Employee Report;E:Employee Mandatory Training Group/Class Report",DIR("A")="Select Option" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!(U[X)!(Y="") D ^PRSEKILL Q
I Y="M" D ^PRSEPRG0 G EN1
E I (DUZ(0)["@"!(+$$EN4^PRSEUTL3($G(DUZ)))) D G:Y'>0 EXIT
. N DIC
. S DIC="^PRSP(454.1,",DIC(0)="AQEMZ",DIC("A")="Select SERVICE: "
. I PRSESER("TX")]"" S DIC("B")=PRSESER("TX")
. W ! D ^DIC Q:Y'>0
. S PSPC=+Y,PSPC("TX")=$P(Y,"^",2)
. Q
SELECT S DIR(0)="SO^A:(A)ll Employees For a Service;S:(S)elected Service Employees",DIR("A")="Select ASSIGNMENT OPTION" D ^DIR K DIR G EXIT:$G(DIRUT) S PRSESEL=Y
I PRSESEL="S" W ! K PRSEXMY F S Y=-1 W !,$S($O(PRSEXMY(0))>0:"Select Another Employee: ",1:"Select EMPLOYEE: ") R X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:(Y<0)
. I X["?" D
.. D MSG21^PRSEMSG I '($O(PRSEXMY(0))>0) S Y=1
.. D MSG2^PRSEMSG S Y=1
.. Q
. S PRSEN=0 S:"'-"[$E(X) X=$E(X,2,999),PRSEN=1
. S DIC("S")="I $P($G(^PRSPC(+Y,1)),U,33)'=""Y"",$G(PSPC(""TX""))=$$EN2^PRSEUTL4(+$G(Y))"
. S DIC="^PRSPC(",DIC(0)="ZMEQ" D ^DIC K DIC I Y'>0,X]"" S Y=0 Q
. I Y>0,PRSEN W $S($D(PRSEXMY(+Y)):" Deleted.",1:" Not selected.") K PRSEXMY(+Y) Q
. S (X,PRSEXMY(+Y))=""
. Q
I PRSESEL="S",'$D(PRSEXMY) G EXIT
DEV ;
S ZTRTN="ENTSK^PRSEPMC"
S (ZTSAVE("PRSESEL"),ZTSAVE("PRSEXMY"),ZTSAVE("PRSEXMY("),ZTSAVE("PSPC"),ZTSAVE("PSPC("))=""
S ZTDESC="Education Tracking mandatory training group/class report"
K %ZIS,IOP D DEV^PRSEUTL G:POP!($D(ZTSK)) EXIT
ENTSK ;
K ^TMP("PRSE",$J)
I PRSESEL="S" D
. S PRSED0=0
. F S PRSED0=$O(PRSEXMY(PRSED0)) Q:PRSED0'>0 D SORT
. Q
I PRSESEL="A",$G(PSPC) D
. S PRS454=0
. F S PRS454=$O(^PRSP(454,1,"ORG","C",PSPC,PRS454)) Q:PRS454'>0 D
.. S CORGCODE=$TR($P($G(^PRSP(454,1,"ORG",PRS454,0)),U),":")
.. S PRSED0=0
.. F S PRSED0=$O(^PRSPC("ACC",CORGCODE,PRSED0)) Q:PRSED0'>0 D SORT
.. Q
. Q
D PRINT
EXIT ;
K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
G:IOST="C" EN1
Q
SORT ;
; ^TMP("PRSE" , $J , Employee_Name , Review_Group_Name , Class_Name)=""
S PRSENAME=$P($G(^PRSPC(PRSED0,0)),"^") Q:PRSENAME=""
S PRSED1=0
F S PRSED1=$O(^PRSPC(PRSED0,5,PRSED1)) Q:PRSED1'>0 D
. S PRSEGD0=+$G(^PRSPC(PRSED0,5,PRSED1,0)),PRSEDT=$P($G(^(0)),U,2)
. S PRSEGRP=$P($G(^PRSE(452.3,PRSEGD0,0)),"^") Q:PRSEGRP=""
. S PRSEGD1=0
. F S PRSEGD1=$O(^PRSE(452.3,PRSEGD0,1,PRSEGD1)) Q:PRSEGD1'>0 D
.. S PRSECD0=+$G(^PRSE(452.3,PRSEGD0,1,PRSEGD1,0))
.. S PRSECLAS=$P($G(^PRSE(452.1,PRSECD0,0)),"^") Q:PRSECLAS=""
.. S ^TMP("PRSE",$J,PRSENAME,PRSEGRP)=PRSEDT
.. S ^TMP("PRSE",$J,PRSENAME,PRSEGRP,PRSECLAS)=""
.. Q
. I $O(^TMP("PRSE",$J,PRSENAME,PRSEGRP,""))="" D
.. S ^TMP("PRSE",$J,PRSENAME,PRSEGRP,"NONE")=""
.. Q
. Q
S PRSEGRP="~INDV. CLASSES"
S PRSED1=0
F S PRSED1=$O(^PRSPC(PRSED0,6,PRSED1)) Q:PRSED1'>0 D
. S PRSE=$G(^PRSPC(PRSED0,6,PRSED1,0))
. S PRSECD0=+PRSE,PRSECNT=+$P(PRSE,"^",2),PRSEDT=$P(PRSE,"^",3)
. Q:PRSECNT
. S PRSECLAS=$P($G(^PRSE(452.1,PRSECD0,0)),"^") Q:PRSECLAS=""
. S ^TMP("PRSE",$J,PRSENAME,PRSEGRP,PRSECLAS)=PRSEDT
. Q
I $O(^TMP("PRSE",$J,PRSENAME,""))="" D
. S ^TMP("PRSE",$J,PRSENAME,"NONE","NONE")=""
. Q
Q
PRINT ;
S POUT=0,PRSEPAGE=1,PRSEUNDL="",$P(PRSEUNDL,"-",81)=""
S Y=DT D DD^%DT S PRSENOW=Y
U IO D HEADER
I $O(^TMP("PRSE",$J,""))="" W !!,"No data found for this report." Q
S PRSENAME=""
F S PRSENAME=$O(^TMP("PRSE",$J,PRSENAME)) Q:PRSENAME=""!POUT D
. W !!,PRSENAME I $Y>(IOSL-6) D PAUSE,HEADER
. S PRSEGRP=""
. F S PRSEGRP=$O(^TMP("PRSE",$J,PRSENAME,PRSEGRP)) Q:PRSEGRP=""!POUT D
.. S Y="" S:PRSEGRP'["~" Y=$G(^TMP("PRSE",$J,PRSENAME,PRSEGRP)) D:Y>0 DD^%DT W !?5,$E(PRSEGRP,$E(PRSEGRP)="~"+1,20) W:Y'="" ?26,Y I $Y>(IOSL-6) D PAUSE,HEADER
.. S PRSECLAS=""
.. F S PRSECLAS=$O(^TMP("PRSE",$J,PRSENAME,PRSEGRP,PRSECLAS)) Q:PRSECLAS=""!POUT S PRSEDT=^(PRSECLAS) D
... S Y=$S(PRSEGRP["~":$G(^TMP("PRSE",$J,PRSENAME,PRSEGRP,PRSECLAS)),1:$G(^TMP("PRSE",$J,PRSENAME,PRSEGRP))) D:Y>0 DD^%DT W ! W:Y'="" ?26,Y W ?42,$E(PRSECLAS,1,36) I $Y>(IOSL-6) D PAUSE,HEADER
... Q
.. Q
. Q
Q
PAUSE ;
I $E(IOST)'="C" Q
K DIR S DIR(0)="E" D ^DIR S POUT=$S(Y'>0:1,1:0)
Q
I POUT Q
I ($E(IOST)="C")!(PRSEPAGE>1) W @IOF
W !?17,"EMPLOYEE MANDATORY TRAINING GROUP/CLASS REPORT",?68,PRSENOW
W !?80-$L(PSPC("TX"))/2,PSPC("TX")
W !,"EMPLOYEE",?10,"REVIEW GROUP",?26,"DATE ASSIGNED",?42,"PROGRAM/CLASS"
W ?68,"PAGE: ",PRSEPAGE,!,PRSEUNDL
S PRSEPAGE=PRSEPAGE+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEPMC 4840 printed Apr 09, 2024@21:31:10 Page 2
PRSEPMC ;HISC/DAD-EMPLOYEE MANDATORY TRAINING GROUP/CLASS REPORT ;4/24/1998
+1 ;;4.0;PAID;**41**;Sep 21, 1995
EN1 ; ENTRY POINT FROM OPTION
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 DO EN2^PRSEUTL3($GET(DUZ))
+3 IF PRSESER'>0
IF '(DUZ(0)="@")
DO MSG3^PRSEMSG
GOTO EXIT
+4 SET PSPC=PRSESER
SET PSPC("TX")=PRSESER("TX")
SEL KILL Y
SET DIR(0)="SO^M:Mandatory Training Group/Employee Report;E:Employee Mandatory Training Group/Class Report"
SET DIR("A")="Select Option"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))!(U[X)!(Y="")
DO ^PRSEKILL
QUIT
+1 IF Y="M"
DO ^PRSEPRG0
GOTO EN1
+2 IF '$TEST
IF (DUZ(0)["@"!(+$$EN4^PRSEUTL3($GET(DUZ))))
Begin DoDot:1
+3 NEW DIC
+4 SET DIC="^PRSP(454.1,"
SET DIC(0)="AQEMZ"
SET DIC("A")="Select SERVICE: "
+5 IF PRSESER("TX")]""
SET DIC("B")=PRSESER("TX")
+6 WRITE !
DO ^DIC
if Y'>0
QUIT
+7 SET PSPC=+Y
SET PSPC("TX")=$PIECE(Y,"^",2)
+8 QUIT
End DoDot:1
if Y'>0
GOTO EXIT
SELECT SET DIR(0)="SO^A:(A)ll Employees For a Service;S:(S)elected Service Employees"
SET DIR("A")="Select ASSIGNMENT OPTION"
DO ^DIR
KILL DIR
if $GET(DIRUT)
GOTO EXIT
SET PRSESEL=Y
+1 IF PRSESEL="S"
WRITE !
KILL PRSEXMY
FOR
SET Y=-1
WRITE !,$SELECT($ORDER(PRSEXMY(0))>0:"Select Another Employee: ",1:"Select EMPLOYEE: ")
READ X:DTIME
if '$TEST
SET X="^^"
if X=""
SET Y=""
if "^^"[X
QUIT
Begin DoDot:1
+2 IF X["?"
Begin DoDot:2
+3 DO MSG21^PRSEMSG
IF '($ORDER(PRSEXMY(0))>0)
SET Y=1
+4 DO MSG2^PRSEMSG
SET Y=1
+5 QUIT
End DoDot:2
+6 SET PRSEN=0
if "'-"[$EXTRACT(X)
SET X=$EXTRACT(X,2,999)
SET PRSEN=1
+7 SET DIC("S")="I $P($G(^PRSPC(+Y,1)),U,33)'=""Y"",$G(PSPC(""TX""))=$$EN2^PRSEUTL4(+$G(Y))"
+8 SET DIC="^PRSPC("
SET DIC(0)="ZMEQ"
DO ^DIC
KILL DIC
IF Y'>0
IF X]""
SET Y=0
QUIT
+9 IF Y>0
IF PRSEN
WRITE $SELECT($DATA(PRSEXMY(+Y)):" Deleted.",1:" Not selected.")
KILL PRSEXMY(+Y)
QUIT
+10 SET (X,PRSEXMY(+Y))=""
+11 QUIT
End DoDot:1
if (Y<0)
QUIT
+12 IF PRSESEL="S"
IF '$DATA(PRSEXMY)
GOTO EXIT
DEV ;
+1 SET ZTRTN="ENTSK^PRSEPMC"
+2 SET (ZTSAVE("PRSESEL"),ZTSAVE("PRSEXMY"),ZTSAVE("PRSEXMY("),ZTSAVE("PSPC"),ZTSAVE("PSPC("))=""
+3 SET ZTDESC="Education Tracking mandatory training group/class report"
+4 KILL %ZIS,IOP
DO DEV^PRSEUTL
if POP!($DATA(ZTSK))
GOTO EXIT
ENTSK ;
+1 KILL ^TMP("PRSE",$JOB)
+2 IF PRSESEL="S"
Begin DoDot:1
+3 SET PRSED0=0
+4 FOR
SET PRSED0=$ORDER(PRSEXMY(PRSED0))
if PRSED0'>0
QUIT
DO SORT
+5 QUIT
End DoDot:1
+6 IF PRSESEL="A"
IF $GET(PSPC)
Begin DoDot:1
+7 SET PRS454=0
+8 FOR
SET PRS454=$ORDER(^PRSP(454,1,"ORG","C",PSPC,PRS454))
if PRS454'>0
QUIT
Begin DoDot:2
+9 SET CORGCODE=$TRANSLATE($PIECE($GET(^PRSP(454,1,"ORG",PRS454,0)),U),":")
+10 SET PRSED0=0
+11 FOR
SET PRSED0=$ORDER(^PRSPC("ACC",CORGCODE,PRSED0))
if PRSED0'>0
QUIT
DO SORT
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 DO PRINT
EXIT ;
+1 KILL ^TMP("PRSE",$JOB)
DO CLOSE^PRSEUTL
DO ^PRSEKILL
+2 if IOST="C"
GOTO EN1
+3 QUIT
SORT ;
+1 ; ^TMP("PRSE" , $J , Employee_Name , Review_Group_Name , Class_Name)=""
+2 SET PRSENAME=$PIECE($GET(^PRSPC(PRSED0,0)),"^")
if PRSENAME=""
QUIT
+3 SET PRSED1=0
+4 FOR
SET PRSED1=$ORDER(^PRSPC(PRSED0,5,PRSED1))
if PRSED1'>0
QUIT
Begin DoDot:1
+5 SET PRSEGD0=+$GET(^PRSPC(PRSED0,5,PRSED1,0))
SET PRSEDT=$PIECE($GET(^(0)),U,2)
+6 SET PRSEGRP=$PIECE($GET(^PRSE(452.3,PRSEGD0,0)),"^")
if PRSEGRP=""
QUIT
+7 SET PRSEGD1=0
+8 FOR
SET PRSEGD1=$ORDER(^PRSE(452.3,PRSEGD0,1,PRSEGD1))
if PRSEGD1'>0
QUIT
Begin DoDot:2
+9 SET PRSECD0=+$GET(^PRSE(452.3,PRSEGD0,1,PRSEGD1,0))
+10 SET PRSECLAS=$PIECE($GET(^PRSE(452.1,PRSECD0,0)),"^")
if PRSECLAS=""
QUIT
+11 SET ^TMP("PRSE",$JOB,PRSENAME,PRSEGRP)=PRSEDT
+12 SET ^TMP("PRSE",$JOB,PRSENAME,PRSEGRP,PRSECLAS)=""
+13 QUIT
End DoDot:2
+14 IF $ORDER(^TMP("PRSE",$JOB,PRSENAME,PRSEGRP,""))=""
Begin DoDot:2
+15 SET ^TMP("PRSE",$JOB,PRSENAME,PRSEGRP,"NONE")=""
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 SET PRSEGRP="~INDV. CLASSES"
+19 SET PRSED1=0
+20 FOR
SET PRSED1=$ORDER(^PRSPC(PRSED0,6,PRSED1))
if PRSED1'>0
QUIT
Begin DoDot:1
+21 SET PRSE=$GET(^PRSPC(PRSED0,6,PRSED1,0))
+22 SET PRSECD0=+PRSE
SET PRSECNT=+$PIECE(PRSE,"^",2)
SET PRSEDT=$PIECE(PRSE,"^",3)
+23 if PRSECNT
QUIT
+24 SET PRSECLAS=$PIECE($GET(^PRSE(452.1,PRSECD0,0)),"^")
if PRSECLAS=""
QUIT
+25 SET ^TMP("PRSE",$JOB,PRSENAME,PRSEGRP,PRSECLAS)=PRSEDT
+26 QUIT
End DoDot:1
+27 IF $ORDER(^TMP("PRSE",$JOB,PRSENAME,""))=""
Begin DoDot:1
+28 SET ^TMP("PRSE",$JOB,PRSENAME,"NONE","NONE")=""
+29 QUIT
End DoDot:1
+30 QUIT
PRINT ;
+1 SET POUT=0
SET PRSEPAGE=1
SET PRSEUNDL=""
SET $PIECE(PRSEUNDL,"-",81)=""
+2 SET Y=DT
DO DD^%DT
SET PRSENOW=Y
+3 USE IO
DO HEADER
+4 IF $ORDER(^TMP("PRSE",$JOB,""))=""
WRITE !!,"No data found for this report."
QUIT
+5 SET PRSENAME=""
+6 FOR
SET PRSENAME=$ORDER(^TMP("PRSE",$JOB,PRSENAME))
if PRSENAME=""!POUT
QUIT
Begin DoDot:1
+7 WRITE !!,PRSENAME
IF $Y>(IOSL-6)
DO PAUSE
DO HEADER
+8 SET PRSEGRP=""
+9 FOR
SET PRSEGRP=$ORDER(^TMP("PRSE",$JOB,PRSENAME,PRSEGRP))
if PRSEGRP=""!POUT
QUIT
Begin DoDot:2
+10 SET Y=""
if PRSEGRP'["~"
SET Y=$GET(^TMP("PRSE",$JOB,PRSENAME,PRSEGRP))
if Y>0
DO DD^%DT
WRITE !?5,$EXTRACT(PRSEGRP,$EXTRACT(PRSEGRP)="~"+1,20)
if Y'=""
WRITE ?26,Y
IF $Y>(IOSL-6)
DO PAUSE
DO HEADER
+11 SET PRSECLAS=""
+12 FOR
SET PRSECLAS=$ORDER(^TMP("PRSE",$JOB,PRSENAME,PRSEGRP,PRSECLAS))
if PRSECLAS=""!POUT
QUIT
SET PRSEDT=^(PRSECLAS)
Begin DoDot:3
+13 SET Y=$SELECT(PRSEGRP["~":$GET(^TMP("PRSE",$JOB,PRSENAME,PRSEGRP,PRSECLAS)),1:$GET(^TMP("PRSE",$JOB,PRSENAME,PRSEGRP)))
if Y>0
DO DD^%DT
WRITE !
if Y'=""
WRITE ?26,Y
WRITE ?42,$EXTRACT(PRSECLAS,1,36)
IF $Y>(IOSL-6)
DO PAUSE
DO HEADER
+14 QUIT
End DoDot:3
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
PAUSE ;
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET POUT=$SELECT(Y'>0:1,1:0)
+3 QUIT
+1 IF POUT
QUIT
+2 IF ($EXTRACT(IOST)="C")!(PRSEPAGE>1)
WRITE @IOF
+3 WRITE !?17,"EMPLOYEE MANDATORY TRAINING GROUP/CLASS REPORT",?68,PRSENOW
+4 WRITE !?80-$LENGTH(PSPC("TX"))/2,PSPC("TX")
+5 WRITE !,"EMPLOYEE",?10,"REVIEW GROUP",?26,"DATE ASSIGNED",?42,"PROGRAM/CLASS"
+6 WRITE ?68,"PAGE: ",PRSEPAGE,!,PRSEUNDL
+7 SET PRSEPAGE=PRSEPAGE+1
+8 QUIT
