PRSEED13 ;HISC/MD-EMPLY MANDATORY TRAINING GRP/CLAS ENTER/EDIT ;12/93
;;4.0;PAID;;Sep 21, 1995
EN1 ; OPTION PRSE-MI
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
D EN2^PRSEUTL3($G(DUZ)) I PRSESER'>0 D MSG3^PRSEMSG S POUT=1 G QQ
S PSPC=$G(PRSESER),PSPC("TX")=$G(PRSESER("TX"))
SELECT S DIR(0)="SO^A:(A)ll Employees For a Service;"_$S((+$$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)["@")):"M:(M)ultiple Services - All Employees;",1:"")_"S:(S)elected Service Employees",DIR("A")="Select ASSIGNMENT OPTION"
D ^DIR K DIR G QQ:$G(DIRUT) S PRSESEL=Y
I PRSESEL="M" D EN1^PRSEUTL6 G:+$G(POUT) QQ
S DIR(0)="SO^A:(A)dd Group(s);D:(D)elete Group(s)"_$S(PRSESEL="S":";E:(E)nter/Edit Class(es)",1:""),DIR("A")="Select ACTION" D ^DIR K DIR G:$G(DIRUT) QQ S PRSEACT=Y
I ($G(PRSESEL)="S"!($G(PRSESEL)="A")),(DUZ(0)["@"!(+$$EN4^PRSEUTL3($G(DUZ)))) D G:$G(DIRUT) QQ
.W ! S DIC=454.1,DIC(0)="AEQZ",DIC("S")="I $P(^(0),U)'=""MISCELLANEOUS"""
.S DIC("A")="Select SERVICE: " S:$G(PRSESER("TX"))'="" DIC("B")=PRSESER("TX") D ^DIC K DIC S PSPC=+Y,PSPC("TX")=$P($G(Y),U,2)
I PRSEACT="A" W ! S %DT("A")="DATE ASSIGNED: ",%DT("B")="TODAY",%DT="AE" D ^%DT G:Y'>0 QQ S PRSEDT=Y
I '(PRSEACT="E") D DISP^PRSEUTL4 I $G(POUT) S POUT=0 G SELECT
I PRSESEL="S" W ! K PRSEXMY F K POUT 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
..I 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)))!($$EN4^PRSEUTL3($G(DUZ)))",DIC="^PRSPC(",DIC(0)="EQZ" D ^DIC I Y'>0,X]"" S Y=0 Q
.I Y>0,PRSEN W $S($D(PRSEXMY(+Y)):" Deleted.",1:" Not a current recipient") K PRSEXMY(+Y) Q
.S (X,PRSEXMY(+Y))=""
.Q
G:X["^" QQ
I PRSESEL="S",'$D(PRSEXMY) G QQ
I PRSESEL="S" W ! F PRSEDA=0:0 S PRSEDA=$O(PRSEXMY(PRSEDA)) Q:PRSEDA'>0 D
.;GRP EDIT
.S DA=PRSEDA I $D(^PRSPC(DA,0)) W:PRSEACT="E" @IOF,$P($G(^(0)),U) S:'$D(^PRSPC(DA,6,0)) ^(0)="^450.0633PA^^"
.I PRSEACT="E" D
..;CLAS EDIT
..S:'$D(^PRSPC(DA,6,0)) ^(0)="^450.0633PA^^" S DR="633",DR(2,450.0633)=".01;S:$P($G(^PRSPC(DA(1),6,DA,0)),U,3) Y=""@3"";.03///TODAY;S X=X;@3;.03",DIE="^PRSPC(" D ^DIE,EN1^PRSEUTL5(PRSEDA) K DR
..Q
.Q:PRSEACT="E" S PRSEROUT=$S(PRSEACT="A":"ADD",PRSEACT="D":"DEL",1:"") D:$G(PRSEROUT)'="" @(PRSEROUT)
.Q
I ($G(PRSESEL)="A"!($G(PRSESEL)="M")) D
.F X="PRSEDT","PRSEMI(","PRSEACT","PRSESEL","PSPC","PSPC(","^TMP(""PRSEMP"",$J,","^TMP(""PRSESRV"",$J,","^TMP(""PRSEGRP"",$J," S ZTSAVE(X)=""
.S ZTRTN="START^PRSEED13",ZTIO="",ZTDTH=$H,ZTDESC="Education Tracking Employee Mandatory Grp Update" D ^%ZTLOAD
.K ZTDTH,ZTDESC,ZTRTN,ZTSAVE,ZTIO
.I $D(ZTSK) W !!,"This/These group(s) will be "_$S(PRSEACT="A":"assigned",1:"deleted")_" by a background Job."
.Q
W ! G SELECT
ADD ;ADD MI GRP
S DA(1)=PRSEDA F PRSEX=0:0 S PRSEX=$O(^TMP("PRSEGRP",$J,PRSEX)) Q:PRSEX'>0 D
.I $E(IOST)="C",$D(^PRSPC(DA(1),5,"B",PRSEX)) W $C(7),!,$P($G(^PRSPC(DA(1),0)),U)," is assigned the ",$P($G(^PRSE(452.3,+PRSEX,0)),U,1)," group!" Q
.I '$D(^PRSPC(DA(1),5,"B",PRSEX)),$P($G(^PRSPC(DA(1),1)),U,33)'="Y" K DD,DO S DA(1)=PRSEDA,DLAYGO=450.0632,DIC="^PRSPC(DA(1),5,",X=PRSEX,DIC(0)="EL",DIC("P")="450.0632P",DIC("DR")=".02///^S X=PRSEDT" D FILE^DICN K DIC D EN1^PRSEUTL5(PRSEDA)
.Q
Q
DEL ;REMOVE MI GRP
S DA(1)=PRSEDA F PRSEX=0:0 S PRSEX=$O(^TMP("PRSEGRP",$J,PRSEX)) Q:PRSEX'>0 D
.W:$E(IOST)="C" "." I $D(^PRSPC(DA(1),5,"B",PRSEX)) S DA=$O(^PRSPC(DA(1),5,"B",PRSEX,0)),DIK="^PRSPC(DA(1),5," D ^DIK K DIK D EN1^PRSEUTL5(PRSEDA)
.I $O(^PRSPC("ARG",PRSEX,0))'>0,'$D(ZTQUEUED) D
..W !!,$P($G(^PRSE(452.3,+PRSEX,0)),U),!,"There are no assignees for this training group do you want to delete it"
..S %=2 D YN^DICN
..I %=1 S DIK="^PRSE(452.3,",DA=PRSEX D ^DIK
..Q
.Q
Q
QQ K ^TMP("PRSESRV",$J),^TMP("PRSEMP",$J),^TMP("PRSEGRP",$J) D ^PRSEKILL
Q
START ;TASKMAN ENTRY POINT
K ^TMP("PRSEMP",$J) S:PRSESEL="A" ^TMP("PRSESRV",$J,PSPC)="" F PSPC(1)=0:0 S PSPC(1)=$O(^TMP("PRSESRV",$J,PSPC(1))) Q:PSPC(1)'>0 D
.S PRS454=0
.F S PRS454=$O(^PRSP(454,1,"ORG","C",PSPC(1),PRS454)) Q:PRS454'>0 D
..S CORGCODE=$TR($P($G(^PRSP(454,1,"ORG",PRS454,0)),U),":")
..I CORGCODE]"" D
...S DA=0 F S DA=$O(^PRSPC("ACC",CORGCODE,DA)) Q:DA'>0 S:$G(^PRSPC(DA,0))'="" ^TMP("PRSEMP",$J,DA)=""
...Q
..Q
.Q
F PRSEDA=0:0 S PRSEDA=$O(^TMP("PRSEMP",$J,PRSEDA)) Q:PRSEDA'>0 S PRSEROUT=$S(PRSEACT="A":"ADD^PRSEED13",PRSEACT="D":"DEL^PRSEED13",1:"") D @(PRSEROUT)
S XQAMSG="Mandatory Training Group(s) "_$S(PRSEACT="A":"assigned",1:"deleted")_" for "_$S(PRSESEL="A":PSPC("TX"),1:"Selected Service(s)"),XQA(DUZ)="" D SETUP^XQALERT
D QQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEED13 4786 printed Apr 09, 2024@21:29:02 Page 2
PRSEED13 ;HISC/MD-EMPLY MANDATORY TRAINING GRP/CLAS ENTER/EDIT ;12/93
+1 ;;4.0;PAID;;Sep 21, 1995
EN1 ; OPTION PRSE-MI
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 DO EN2^PRSEUTL3($GET(DUZ))
IF PRSESER'>0
DO MSG3^PRSEMSG
SET POUT=1
GOTO QQ
+3 SET PSPC=$GET(PRSESER)
SET PSPC("TX")=$GET(PRSESER("TX"))
SELECT SET DIR(0)="SO^A:(A)ll Employees For a Service;"_$SELECT((+$$EN4^PRSEUTL3($GET(DUZ))!(DUZ(0)["@")):"M:(M)ultiple Services - All Employees;",1:"")_"S:(S)elected Service Employees"
SET DIR("A")="Select ASSIGNMENT OPTION"
+1 DO ^DIR
KILL DIR
if $GET(DIRUT)
GOTO QQ
SET PRSESEL=Y
+2 IF PRSESEL="M"
DO EN1^PRSEUTL6
if +$GET(POUT)
GOTO QQ
+3 SET DIR(0)="SO^A:(A)dd Group(s);D:(D)elete Group(s)"_$SELECT(PRSESEL="S":";E:(E)nter/Edit Class(es)",1:"")
SET DIR("A")="Select ACTION"
DO ^DIR
KILL DIR
if $GET(DIRUT)
GOTO QQ
SET PRSEACT=Y
+4 IF ($GET(PRSESEL)="S"!($GET(PRSESEL)="A"))
IF (DUZ(0)["@"!(+$$EN4^PRSEUTL3($GET(DUZ))))
Begin DoDot:1
+5 WRITE !
SET DIC=454.1
SET DIC(0)="AEQZ"
SET DIC("S")="I $P(^(0),U)'=""MISCELLANEOUS"""
+6 SET DIC("A")="Select SERVICE: "
if $GET(PRSESER("TX"))'=""
SET DIC("B")=PRSESER("TX")
DO ^DIC
KILL DIC
SET PSPC=+Y
SET PSPC("TX")=$PIECE($GET(Y),U,2)
End DoDot:1
if $GET(DIRUT)
GOTO QQ
+7 IF PRSEACT="A"
WRITE !
SET %DT("A")="DATE ASSIGNED: "
SET %DT("B")="TODAY"
SET %DT="AE"
DO ^%DT
if Y'>0
GOTO QQ
SET PRSEDT=Y
+8 IF '(PRSEACT="E")
DO DISP^PRSEUTL4
IF $GET(POUT)
SET POUT=0
GOTO SELECT
+9 IF PRSESEL="S"
WRITE !
KILL PRSEXMY
FOR
KILL POUT
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
+10 IF X["?"
Begin DoDot:2
+11 DO MSG21^PRSEMSG
IF '($ORDER(PRSEXMY(0))>0)
SET Y=1
+12 IF Y'=1
DO MSG2^PRSEMSG
SET Y=1
+13 QUIT
End DoDot:2
+14 SET PRSEN=0
if "'-"[$EXTRACT(X)
SET X=$EXTRACT(X,2,999)
SET PRSEN=1
+15 SET DIC("S")="I $P($G(^PRSPC(+Y,1)),U,33)'=""Y""&($G(PSPC(""TX""))=$$EN2^PRSEUTL4(+$G(Y)))!($$EN4^PRSEUTL3($G(DUZ)))"
SET DIC="^PRSPC("
SET DIC(0)="EQZ"
DO ^DIC
IF Y'>0
IF X]""
SET Y=0
QUIT
+16 IF Y>0
IF PRSEN
WRITE $SELECT($DATA(PRSEXMY(+Y)):" Deleted.",1:" Not a current recipient")
KILL PRSEXMY(+Y)
QUIT
+17 SET (X,PRSEXMY(+Y))=""
+18 QUIT
End DoDot:1
if (Y<0)
QUIT
+19 if X["^"
GOTO QQ
+20 IF PRSESEL="S"
IF '$DATA(PRSEXMY)
GOTO QQ
+21 IF PRSESEL="S"
WRITE !
FOR PRSEDA=0:0
SET PRSEDA=$ORDER(PRSEXMY(PRSEDA))
if PRSEDA'>0
QUIT
Begin DoDot:1
+22 ;GRP EDIT
+23 SET DA=PRSEDA
IF $DATA(^PRSPC(DA,0))
if PRSEACT="E"
WRITE @IOF,$PIECE($GET(^(0)),U)
if '$DATA(^PRSPC(DA,6,0))
SET ^(0)="^450.0633PA^^"
+24 IF PRSEACT="E"
Begin DoDot:2
+25 ;CLAS EDIT
+26 if '$DATA(^PRSPC(DA,6,0))
SET ^(0)="^450.0633PA^^"
SET DR="633"
SET DR(2,450.0633)=".01;S:$P($G(^PRSPC(DA(1),6,DA,0)),U,3) Y=""@3"";.03///TODAY;S X=X;@3;.03"
SET DIE="^PRSPC("
DO ^DIE
DO EN1^PRSEUTL5(PRSEDA)
KILL DR
+27 QUIT
End DoDot:2
+28 if PRSEACT="E"
QUIT
SET PRSEROUT=$SELECT(PRSEACT="A":"ADD",PRSEACT="D":"DEL",1:"")
if $GET(PRSEROUT)'=""
DO @(PRSEROUT)
+29 QUIT
End DoDot:1
+30 IF ($GET(PRSESEL)="A"!($GET(PRSESEL)="M"))
Begin DoDot:1
+31 FOR X="PRSEDT","PRSEMI(","PRSEACT","PRSESEL","PSPC","PSPC(","^TMP(""PRSEMP"",$J,","^TMP(""PRSESRV"",$J,","^TMP(""PRSEGRP"",$J,"
SET ZTSAVE(X)=""
+32 SET ZTRTN="START^PRSEED13"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="Education Tracking Employee Mandatory Grp Update"
DO ^%ZTLOAD
+33 KILL ZTDTH,ZTDESC,ZTRTN,ZTSAVE,ZTIO
+34 IF $DATA(ZTSK)
WRITE !!,"This/These group(s) will be "_$SELECT(PRSEACT="A":"assigned",1:"deleted")_" by a background Job."
+35 QUIT
End DoDot:1
+36 WRITE !
GOTO SELECT
ADD ;ADD MI GRP
+1 SET DA(1)=PRSEDA
FOR PRSEX=0:0
SET PRSEX=$ORDER(^TMP("PRSEGRP",$JOB,PRSEX))
if PRSEX'>0
QUIT
Begin DoDot:1
+2 IF $EXTRACT(IOST)="C"
IF $DATA(^PRSPC(DA(1),5,"B",PRSEX))
WRITE $CHAR(7),!,$PIECE($GET(^PRSPC(DA(1),0)),U)," is assigned the ",$PIECE($GET(^PRSE(452.3,+PRSEX,0)),U,1)," group!"
QUIT
+3 IF '$DATA(^PRSPC(DA(1),5,"B",PRSEX))
IF $PIECE($GET(^PRSPC(DA(1),1)),U,33)'="Y"
KILL DD,DO
SET DA(1)=PRSEDA
SET DLAYGO=450.0632
SET DIC="^PRSPC(DA(1),5,"
SET X=PRSEX
SET DIC(0)="EL"
SET DIC("P")="450.0632P"
SET DIC("DR")=".02///^S X=PRSEDT"
DO FILE^DICN
KILL DIC
DO EN1^PRSEUTL5(PRSEDA)
+4 QUIT
End DoDot:1
+5 QUIT
DEL ;REMOVE MI GRP
+1 SET DA(1)=PRSEDA
FOR PRSEX=0:0
SET PRSEX=$ORDER(^TMP("PRSEGRP",$JOB,PRSEX))
if PRSEX'>0
QUIT
Begin DoDot:1
+2 if $EXTRACT(IOST)="C"
WRITE "."
IF $DATA(^PRSPC(DA(1),5,"B",PRSEX))
SET DA=$ORDER(^PRSPC(DA(1),5,"B",PRSEX,0))
SET DIK="^PRSPC(DA(1),5,"
DO ^DIK
KILL DIK
DO EN1^PRSEUTL5(PRSEDA)
+3 IF $ORDER(^PRSPC("ARG",PRSEX,0))'>0
IF '$DATA(ZTQUEUED)
Begin DoDot:2
+4 WRITE !!,$PIECE($GET(^PRSE(452.3,+PRSEX,0)),U),!,"There are no assignees for this training group do you want to delete it"
+5 SET %=2
DO YN^DICN
+6 IF %=1
SET DIK="^PRSE(452.3,"
SET DA=PRSEX
DO ^DIK
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
QQ KILL ^TMP("PRSESRV",$JOB),^TMP("PRSEMP",$JOB),^TMP("PRSEGRP",$JOB)
DO ^PRSEKILL
+1 QUIT
START ;TASKMAN ENTRY POINT
+1 KILL ^TMP("PRSEMP",$JOB)
if PRSESEL="A"
SET ^TMP("PRSESRV",$JOB,PSPC)=""
FOR PSPC(1)=0:0
SET PSPC(1)=$ORDER(^TMP("PRSESRV",$JOB,PSPC(1)))
if PSPC(1)'>0
QUIT
Begin DoDot:1
+2 SET PRS454=0
+3 FOR
SET PRS454=$ORDER(^PRSP(454,1,"ORG","C",PSPC(1),PRS454))
if PRS454'>0
QUIT
Begin DoDot:2
+4 SET CORGCODE=$TRANSLATE($PIECE($GET(^PRSP(454,1,"ORG",PRS454,0)),U),":")
+5 IF CORGCODE]""
Begin DoDot:3
+6 SET DA=0
FOR
SET DA=$ORDER(^PRSPC("ACC",CORGCODE,DA))
if DA'>0
QUIT
if $GET(^PRSPC(DA,0))'=""
SET ^TMP("PRSEMP",$JOB,DA)=""
+7 QUIT
End DoDot:3
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 FOR PRSEDA=0:0
SET PRSEDA=$ORDER(^TMP("PRSEMP",$JOB,PRSEDA))
if PRSEDA'>0
QUIT
SET PRSEROUT=$SELECT(PRSEACT="A":"ADD^PRSEED13",PRSEACT="D":"DEL^PRSEED13",1:"")
DO @(PRSEROUT)
+11 SET XQAMSG="Mandatory Training Group(s) "_$SELECT(PRSEACT="A":"assigned",1:"deleted")_" for "_$SELECT(PRSESEL="A":PSPC("TX"),1:"Selected Service(s)")
SET XQA(DUZ)=""
DO SETUP^XQALERT
+12 DO QQ
+13 QUIT
