source: WorldVistAEHR/trunk/r/PAID-PRS/PRSEUTL2.m@ 949

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<DT) S PRSEW=1 Q
 Q PRSEW
EN3(Y) ; PAST 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>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)'<DT) S Y=(9999999-XXX) I +Y D D^DIQ S PRSEDT=Y Q
 Q PRSEDT
EN5 ; ED. REPORT PROMPTS
 I $D(PRSESEL),PRSESEL="A" Q
 N Y K DUOUT,DTOUT I $D(PRSESEL) D
 .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)))"
 W !!,"Select TRAINING CLASS (Press return for all classes): " R X:DTIME
 I '$T!(X="^") S Y=-1,(DUOUT,DTOUT)=1 G CHECK
 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
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