VistA-WorldVistAEHR/r/PAID-PRS/PRSEPMC.m

116 lines
4.6 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
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
HEADER ;
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