source: FOIAVistA/trunk/r/PAID-PRS/PRSEUTL2.m@ 1166

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1PRSEUTL2 ;HISC/JH/MD-EDUCATIONAL SECURITY ROUTINE ;8/11/92
2 ;;4.0;PAID;**5,20**;Sep 21, 1995
3EN2(Y) ; FUTURE CLASS SCREEN
4 S PRSEW=0,YYY=$O(^PRSE(452.8,"B",+Y,0)) F XXX=0:0 S XXX=$O(^PRSE(452.8,+YYY,3,"B",XXX)) Q:XXX'>0 I '(XXX\1<DT) S PRSEW=1 Q
5 Q PRSEW
6EN3(Y) ; PAST CLASS SCREEN
7 S PRSEW=0,YYY=$O(^PRSE(452.8,"B",+Y,0)) F XXX=0:0 S XXX=$O(^PRSE(452.8,+YYY,3,"B",XXX)) Q:XXX'>0 I '(XXX\1>DT) S PRSEW=1 Q
8 Q PRSEW
9EN4(PRX) ; LATEST FUTURE DATE
10 S PRSEDT=0 F XXX=0:0 S XXX=$O(^PRSE(452.8,PRX,3,"C",XXX)) Q:XXX'>0 I ((9999999-XXX)'<DT) S Y=(9999999-XXX) I +Y D D^DIQ S PRSEDT=Y Q
11 Q PRSEDT
12EN5 ; ED. REPORT PROMPTS
13 I $D(PRSESEL),PRSESEL="A" Q
14 N Y K DUOUT,DTOUT I $D(PRSESEL) D
15 .S DIC("S")="S DAT=$G(^(0)),PRSECLAS=$P($G(DAT),U,2),PRSEIEN=$G(^PRSE(452,""AK"",PRSECLAS,Y)),PRSD0=$O(^PRSE(452.1,""B"",PRSECLAS,0)) I $P(DAT,U,21)=PRSESEL,(PRSEIEN=$G(PRSESER)!(+$$EN4^PRSEUTL3($G(DUZ))!($P($G(^PRSE(452.1,+PRSD0,0)),U,9)=0)))"
16 W !!,"Select TRAINING CLASS (Press return for all classes): " R X:DTIME
17 I '$T!(X="^") S Y=-1,(DUOUT,DTOUT)=1 G CHECK
18 S PRSECLS="",NSP=0,D="AK",DIC="^PRSE(452,",DIC(0)=$E("SQZE",1,(X'=" ")+3) D IX^DIC I X?1"?".E!(Y>0) W:X=" " " ",$P(Y(0),U,2) G:X?1"?".E EN5
19CHECK I '$D(DTOUT),'$D(DUOUT),X="" S NSP=1 Q
20 I $D(DTOUT)!($D(DUOUT)) S POUT=1 Q
21 I +Y'>0 G EN5
22 S (PRSECLS,NSPC)=$P($G(Y(0)),U,2),PRSECLS(0)=+$O(^PRSE(452.1,"B",NSPC,0))
23 Q
24EN6 ; EMPLOYEE SELECTION
25 S DIC("A")="Select Employee Name: ",DIC("W")="I $D(^VA(200,+Y,1)),$P($G(^(1)),U,9)?9N W ?$X+5,$P(^(1),U,9)",DIC(0)="AEMQI",DIC="^VA(200," D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!'(+Y>0) S POUT=1 Q
26 S N1=+Y,N2=$P(Y,U,2)
27 Q
28EN8 ; CLASS LOOKUP/452.8 NEW ENTRY
29 W ! S (DLAYGO,DIC)=452.1,DIC(0)="AEQMLZ",DIC("A")="Select CLASS NAME: ",DIC("S")="I '($P(^PRSE(452.1,+Y,0),U,7)=""""),$P(^(0),U,7)=PRSETYP,(PRSESER=+$P(^(0),U,8)!(DUZ(0)[""@""!(+$$EN4^PRSEUTL3($G(DUZ)))))"
30 S DIC("DR")="7////1;S:'(PRSETYP=""M"") Y=""@1"";4//^S X=""1Y"";@1;5////^S X=PRSETYP;2T"
31 S DIC("W")="S ZZ=+$P(^PRSE(452.1,+Y,0),U,8) W ?($X+5),$P($G(^PRSP(454.1,ZZ,0)),U)"
32 D ^DIC K DIC,DLAYGO I $D(DTOUT)!($D(DUOUT))!'(+Y>0) S X=U Q
33 S PRSEMI=+Y,PRSEPROG=$P(Y,U,2),PRSENEW=$P(Y,U,3),DIE="^PRSE(452.1,",DA=PRSEMI,PRSE=$E(Y(0,0),1,25)
34 S DR="8;"_$S(DUZ(0)["@"!+$$EN4^PRSEUTL3($G(DUZ)):"6//^S X=$G(PRSESER(""TX""))",1:"6////^S X=PRSESER")_";7"
35 I PRSENEW D ^DIE S:$D(Y) DUOUT=1 I $D(DTOUT)!$D(DUOUT) S X=U Q
36 S PRSESER("RG")=+$P(^PRSE(452.1,+PRSEMI,0),U,8),PRSELEN=+$P(^(0),U,3),X=PRSEPROG,DIC="^PRSE(452.8,",DIC(0)="",DIC("S")="I $P(^(0),U)=PRSEMI" D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S X=U Q
37 I +Y'>0 D DATE
38 Q
39DATE ; START DATE LOOKUP
40 K DD,DO S X=PRSEMI,DIC="^PRSE(452.8,",DIC(0)="",DIC("DR")="2.7////^S X=+PRSESER(""RG"");4////^S X=PRSETYP;6////1",DLAYGO=452.8 D FILE^DICN K DIC I +Y'>0 S POUT=1 Q
41 S DA(1)=+Y,^PRSE(452.8,DA(1),3,0)="^452.889ID^^",DIC="^PRSE(452.8,DA(1),3,",DIC(0)="AEQML" D ^DIC I +Y'>0 D
42 . W $C(7),!!,?5,"The START DATE is required to enter this class in the Registration File.",!
43 . Q
44 S Y=DA(1) K DA(1),DIC
45 Q
46 ; I '$O(^PRSE(452.8,+Y,3,0)) W $C(7),!!,?5,"The START DATE is required to enter this class in the Registration File.",!,?5,"Enter '^' to delete the class and exit",! G ENTRDT
47KILL ; DELETE CLASS FROM 452.8 FILE
48 S XX=+^PRSE(452.8,+Y,0) I '$O(^PRSE(452.8,+Y,3,0)) W $C(7),!,?5,"<"_$P(^PRSE(452.1,XX,0),U)_"> DELETED !" S DA=+Y,DIK="^PRSE(452.8," D ^DIK S POUT=1,Y=0 I (+PRSENEW>0) S DA=XX,DIK="^PRSE(452.1," D ^DIK K DIK,PRSENEW S X=""
49 Q
50EN9 ; INPUT TRANSFORM FOR .01-1 SUBFIELDS OF FIELD 89 IN FILE 452.8
51 S PRSE(0)=$S($D(^PRSE(452.8,DA(1),3,DA,0)):^(0),1:""),PRSE("HELP")="DATE MUST BE "_$S(PRSE="S":"EQUAL OR EARLIER THAN DATE ENDED ",1:"EQUAL OR LATER THAN DATE STARTED "),%DT(0)=""
52 I PRSE="S",(+$P(PRSE(0),U,3)>0) S PRSE(1)=+$P(PRSE(0),U,3),%DT(0)=$S((+$P(PRSE(1),".",2)>0):"-"_+PRSE(1),1:"-"_+PRSE(1)_"."_+$P(X,".",2))
53 I PRSE="E",(+$P(PRSE(0),U)>0) S PRSE(1)=+PRSE(0),%DT(0)=$S((+$P(PRSE(1),".",2)>0):+PRSE(1),1:+PRSE(1)_"."_+$P(X,".",2))
54 K:%DT(0)="" %DT(0) S %DT="TE" D ^%DT S X=Y I Y<1 W !?5,PRSE("HELP") K X
55 K %DT,PRSE
56 Q
57EN10 ;INPUT TRANSFORM FOR 2-13 FIELDS OF FILE 452
58 S PRSE(0)=$S($D(^PRSE(452,DA,0)):^(0),1:""),PRSE("HELP")="DATE MUST BE "_$S(PRSE="S":"EQUAL OR EARLIER THAN DATE ENDED ",1:"EQUAL OR LATER THAN DATE STARTED "),%DT(0)=""
59 I PRSE="S",(+$P(PRSE(0),U,14)>0) S PRSE(1)=+$P(PRSE(0),U,14),%DT(0)=$S((+$P(PRSE(1),".",2)>0):"-"_+PRSE(1),1:"-"_+PRSE(1)_"."_+$P(X,".",2))
60 I PRSE="E",(+$P(PRSE(0),U,3)>0) S PRSE(1)=+$P(PRSE(0),U,3),%DT(0)=$S((+$P(PRSE(1),".",2)>0):+PRSE(1),1:+PRSE(1)_"."_+$P(X,".",2))
61 K:%DT(0)="" %DT(0) S %DT="QTE" D ^%DT S X=Y I Y<1 W !?5,PRSE("HELP") K X
62 K %DT,PRSE
63 Q
64EN12(PRCOD) ; TITLE
65 N Y S Y=PRCOD D OST^PRSDUTIL S ZZZ=$G(Y)
66 Q ZZZ
67EN13(COSTCEN) ; LOCATION
68 S PRSELOC="" I COSTCEN'="" S PRSELOC=$O(^PRSP(454,1,"CC","B",COSTCEN,0)) I PRSELOC'="" S PRSELOC=$P($G(^PRSP(454,1,"CC",PRSELOC,0)),U,2)
69 Q PRSELOC
Note: See TracBrowser for help on using the repository browser.