PRSEUTL2 ;HISC/JH/MD-EDUCATIONAL SECURITY ROUTINE ;8/11/92
;;4.0;PAID;**5,20**;Sep 21, 1995
EN2(Y) ; FUTURE CLASS SCREEN
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
0 I '(XXX\1>DT) S PRSEW=1 Q
Q PRSEW
EN4(PRX) ; LATEST FUTURE DATE
S PRSEDT=0 F XXX=0:0 S XXX=$O(^PRSE(452.8,PRX,3,"C",XXX)) Q:XXX'>0 I ((9999999-XXX)'0) W:X=" " " ",$P(Y(0),U,2) G:X?1"?".E EN5
CHECK I '$D(DTOUT),'$D(DUOUT),X="" S NSP=1 Q
I $D(DTOUT)!($D(DUOUT)) S POUT=1 Q
I +Y'>0 G EN5
S (PRSECLS,NSPC)=$P($G(Y(0)),U,2),PRSECLS(0)=+$O(^PRSE(452.1,"B",NSPC,0))
Q
EN6 ; EMPLOYEE SELECTION
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
S N1=+Y,N2=$P(Y,U,2)
Q
EN8 ; CLASS LOOKUP/452.8 NEW ENTRY
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)))))"
S DIC("DR")="7////1;S:'(PRSETYP=""M"") Y=""@1"";4//^S X=""1Y"";@1;5////^S X=PRSETYP;2T"
S DIC("W")="S ZZ=+$P(^PRSE(452.1,+Y,0),U,8) W ?($X+5),$P($G(^PRSP(454.1,ZZ,0)),U)"
D ^DIC K DIC,DLAYGO I $D(DTOUT)!($D(DUOUT))!'(+Y>0) S X=U Q
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)
S DR="8;"_$S(DUZ(0)["@"!+$$EN4^PRSEUTL3($G(DUZ)):"6//^S X=$G(PRSESER(""TX""))",1:"6////^S X=PRSESER")_";7"
I PRSENEW D ^DIE S:$D(Y) DUOUT=1 I $D(DTOUT)!$D(DUOUT) S X=U Q
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
I +Y'>0 D DATE
Q
DATE ; START DATE LOOKUP
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
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
. W $C(7),!!,?5,"The START DATE is required to enter this class in the Registration File.",!
. Q
S Y=DA(1) K DA(1),DIC
Q
; 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
KILL ; DELETE CLASS FROM 452.8 FILE
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=""
Q
EN9 ; INPUT TRANSFORM FOR .01-1 SUBFIELDS OF FIELD 89 IN FILE 452.8
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)=""
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))
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))
K:%DT(0)="" %DT(0) S %DT="TE" D ^%DT S X=Y I Y<1 W !?5,PRSE("HELP") K X
K %DT,PRSE
Q
EN10 ;INPUT TRANSFORM FOR 2-13 FIELDS OF FILE 452
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)=""
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))
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))
K:%DT(0)="" %DT(0) S %DT="QTE" D ^%DT S X=Y I Y<1 W !?5,PRSE("HELP") K X
K %DT,PRSE
Q
EN12(PRCOD) ; TITLE
N Y S Y=PRCOD D OST^PRSDUTIL S ZZZ=$G(Y)
Q ZZZ
EN13(COSTCEN) ; LOCATION
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)
Q PRSELOC