source: FOIAVistA/trunk/r/PAID-PRS/PRSEED13.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1PRSEED13 ;HISC/MD-EMPLY MANDATORY TRAINING GRP/CLAS ENTER/EDIT ;12/93
2 ;;4.0;PAID;;Sep 21, 1995
3EN1 ; OPTION PRSE-MI
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 D EN2^PRSEUTL3($G(DUZ)) I PRSESER'>0 D MSG3^PRSEMSG S POUT=1 G QQ
6 S PSPC=$G(PRSESER),PSPC("TX")=$G(PRSESER("TX"))
7SELECT 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"
8 D ^DIR K DIR G QQ:$G(DIRUT) S PRSESEL=Y
9 I PRSESEL="M" D EN1^PRSEUTL6 G:+$G(POUT) QQ
10 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
11 I ($G(PRSESEL)="S"!($G(PRSESEL)="A")),(DUZ(0)["@"!(+$$EN4^PRSEUTL3($G(DUZ)))) D G:$G(DIRUT) QQ
12 .W ! S DIC=454.1,DIC(0)="AEQZ",DIC("S")="I $P(^(0),U)'=""MISCELLANEOUS"""
13 .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)
14 I PRSEACT="A" W ! S %DT("A")="DATE ASSIGNED: ",%DT("B")="TODAY",%DT="AE" D ^%DT G:Y'>0 QQ S PRSEDT=Y
15 I '(PRSEACT="E") D DISP^PRSEUTL4 I $G(POUT) S POUT=0 G SELECT
16 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)
17 .I X["?" D
18 ..D MSG21^PRSEMSG I '($O(PRSEXMY(0))>0) S Y=1
19 ..I Y'=1 D MSG2^PRSEMSG S Y=1
20 ..Q
21 .S PRSEN=0 S:"'-"[$E(X) X=$E(X,2,999),PRSEN=1
22 .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
23 .I Y>0,PRSEN W $S($D(PRSEXMY(+Y)):" Deleted.",1:" Not a current recipient") K PRSEXMY(+Y) Q
24 .S (X,PRSEXMY(+Y))=""
25 .Q
26 G:X["^" QQ
27 I PRSESEL="S",'$D(PRSEXMY) G QQ
28 I PRSESEL="S" W ! F PRSEDA=0:0 S PRSEDA=$O(PRSEXMY(PRSEDA)) Q:PRSEDA'>0 D
29 .;GRP EDIT
30 .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^^"
31 .I PRSEACT="E" D
32 ..;CLAS EDIT
33 ..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
34 ..Q
35 .Q:PRSEACT="E" S PRSEROUT=$S(PRSEACT="A":"ADD",PRSEACT="D":"DEL",1:"") D:$G(PRSEROUT)'="" @(PRSEROUT)
36 .Q
37 I ($G(PRSESEL)="A"!($G(PRSESEL)="M")) D
38 .F X="PRSEDT","PRSEMI(","PRSEACT","PRSESEL","PSPC","PSPC(","^TMP(""PRSEMP"",$J,","^TMP(""PRSESRV"",$J,","^TMP(""PRSEGRP"",$J," S ZTSAVE(X)=""
39 .S ZTRTN="START^PRSEED13",ZTIO="",ZTDTH=$H,ZTDESC="Education Tracking Employee Mandatory Grp Update" D ^%ZTLOAD
40 .K ZTDTH,ZTDESC,ZTRTN,ZTSAVE,ZTIO
41 .I $D(ZTSK) W !!,"This/These group(s) will be "_$S(PRSEACT="A":"assigned",1:"deleted")_" by a background Job."
42 .Q
43 W ! G SELECT
44ADD ;ADD MI GRP
45 S DA(1)=PRSEDA F PRSEX=0:0 S PRSEX=$O(^TMP("PRSEGRP",$J,PRSEX)) Q:PRSEX'>0 D
46 .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
47 .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)
48 .Q
49 Q
50DEL ;REMOVE MI GRP
51 S DA(1)=PRSEDA F PRSEX=0:0 S PRSEX=$O(^TMP("PRSEGRP",$J,PRSEX)) Q:PRSEX'>0 D
52 .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)
53 .I $O(^PRSPC("ARG",PRSEX,0))'>0,'$D(ZTQUEUED) D
54 ..W !!,$P($G(^PRSE(452.3,+PRSEX,0)),U),!,"There are no assignees for this training group do you want to delete it"
55 ..S %=2 D YN^DICN
56 ..I %=1 S DIK="^PRSE(452.3,",DA=PRSEX D ^DIK
57 ..Q
58 .Q
59 Q
60QQ K ^TMP("PRSESRV",$J),^TMP("PRSEMP",$J),^TMP("PRSEGRP",$J) D ^PRSEKILL
61 Q
62START ;TASKMAN ENTRY POINT
63 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
64 .S PRS454=0
65 .F S PRS454=$O(^PRSP(454,1,"ORG","C",PSPC(1),PRS454)) Q:PRS454'>0 D
66 ..S CORGCODE=$TR($P($G(^PRSP(454,1,"ORG",PRS454,0)),U),":")
67 ..I CORGCODE]"" D
68 ...S DA=0 F S DA=$O(^PRSPC("ACC",CORGCODE,DA)) Q:DA'>0 S:$G(^PRSPC(DA,0))'="" ^TMP("PRSEMP",$J,DA)=""
69 ...Q
70 ..Q
71 .Q
72 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)
73 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
74 D QQ
75 Q
Note: See TracBrowser for help on using the repository browser.