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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEUTL2 4916 printed Dec 13, 2024@02:26:53 Page 2
PRSEUTL2 ;HISC/JH/MD-EDUCATIONAL SECURITY ROUTINE ;8/11/92
+1 ;;4.0;PAID;**5,20**;Sep 21, 1995
EN2(Y) ; FUTURE CLASS SCREEN
+1 SET PRSEW=0
SET YYY=$ORDER(^PRSE(452.8,"B",+Y,0))
FOR XXX=0:0
SET XXX=$ORDER(^PRSE(452.8,+YYY,3,"B",XXX))
if XXX'>0
QUIT
IF '(XXX\1<DT)
SET PRSEW=1
QUIT
+2 QUIT PRSEW
EN3(Y) ; PAST CLASS SCREEN
+1 SET PRSEW=0
SET YYY=$ORDER(^PRSE(452.8,"B",+Y,0))
FOR XXX=0:0
SET XXX=$ORDER(^PRSE(452.8,+YYY,3,"B",XXX))
if XXX'>0
QUIT
IF '(XXX\1>DT)
SET PRSEW=1
QUIT
+2 QUIT PRSEW
EN4(PRX) ; LATEST FUTURE DATE
+1 SET PRSEDT=0
FOR XXX=0:0
SET XXX=$ORDER(^PRSE(452.8,PRX,3,"C",XXX))
if XXX'>0
QUIT
IF ((9999999-XXX)'<DT)
SET Y=(9999999-XXX)
IF +Y
DO D^DIQ
SET PRSEDT=Y
QUIT
+2 QUIT PRSEDT
EN5 ; ED. REPORT PROMPTS
+1 IF $DATA(PRSESEL)
IF PRSESEL="A"
QUIT
+2 NEW Y
KILL DUOUT,DTOUT
IF $DATA(PRSESEL)
Begin DoDot:1
+3 SET 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)))"
End DoDot:1
+4 WRITE !!,"Select TRAINING CLASS (Press return for all classes): "
READ X:DTIME
+5 IF '$TEST!(X="^")
SET Y=-1
SET (DUOUT,DTOUT)=1
GOTO CHECK
+6 SET PRSECLS=""
SET NSP=0
SET D="AK"
SET DIC="^PRSE(452,"
SET DIC(0)=$EXTRACT("SQZE",1,(X'=" ")+3)
DO IX^DIC
IF X?1"?".E!(Y>0)
if X=" "
WRITE " ",$PIECE(Y(0),U,2)
if X?1"?".E
GOTO EN5
CHECK IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF X=""
SET NSP=1
QUIT
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
SET POUT=1
QUIT
+2 IF +Y'>0
GOTO EN5
+3 SET (PRSECLS,NSPC)=$PIECE($GET(Y(0)),U,2)
SET PRSECLS(0)=+$ORDER(^PRSE(452.1,"B",NSPC,0))
+4 QUIT
EN6 ; EMPLOYEE SELECTION
+1 SET DIC("A")="Select Employee Name: "
SET DIC("W")="I $D(^VA(200,+Y,1)),$P($G(^(1)),U,9)?9N W ?$X+5,$P(^(1),U,9)"
SET DIC(0)="AEMQI"
SET DIC="^VA(200,"
DO ^DIC
KILL DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!'(+Y>0)
SET POUT=1
QUIT
+2 SET N1=+Y
SET N2=$PIECE(Y,U,2)
+3 QUIT
EN8 ; CLASS LOOKUP/452.8 NEW ENTRY
+1 WRITE !
SET (DLAYGO,DIC)=452.1
SET DIC(0)="AEQMLZ"
SET DIC("A")="Select CLASS NAME: "
SET 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)))))"
+2 SET DIC("DR")="7////1;S:'(PRSETYP=""M"") Y=""@1"";4//^S X=""1Y"";@1;5////^S X=PRSETYP;2T"
+3 SET DIC("W")="S ZZ=+$P(^PRSE(452.1,+Y,0),U,8) W ?($X+5),$P($G(^PRSP(454.1,ZZ,0)),U)"
+4 DO ^DIC
KILL DIC,DLAYGO
IF $DATA(DTOUT)!($DATA(DUOUT))!'(+Y>0)
SET X=U
QUIT
+5 SET PRSEMI=+Y
SET PRSEPROG=$PIECE(Y,U,2)
SET PRSENEW=$PIECE(Y,U,3)
SET DIE="^PRSE(452.1,"
SET DA=PRSEMI
SET PRSE=$EXTRACT(Y(0,0),1,25)
+6 SET DR="8;"_$SELECT(DUZ(0)["@"!+$$EN4^PRSEUTL3($GET(DUZ)):"6//^S X=$G(PRSESER(""TX""))",1:"6////^S X=PRSESER")_";7"
+7 IF PRSENEW
DO ^DIE
if $DATA(Y)
SET DUOUT=1
IF $DATA(DTOUT)!$DATA(DUOUT)
SET X=U
QUIT
+8 SET PRSESER("RG")=+$PIECE(^PRSE(452.1,+PRSEMI,0),U,8)
SET PRSELEN=+$PIECE(^(0),U,3)
SET X=PRSEPROG
SET DIC="^PRSE(452.8,"
SET DIC(0)=""
SET DIC("S")="I $P(^(0),U)=PRSEMI"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET X=U
QUIT
+9 IF +Y'>0
DO DATE
+10 QUIT
DATE ; START DATE LOOKUP
+1 KILL DD,DO
SET X=PRSEMI
SET DIC="^PRSE(452.8,"
SET DIC(0)=""
SET DIC("DR")="2.7////^S X=+PRSESER(""RG"");4////^S X=PRSETYP;6////1"
SET DLAYGO=452.8
DO FILE^DICN
KILL DIC
IF +Y'>0
SET POUT=1
QUIT
+2 SET DA(1)=+Y
SET ^PRSE(452.8,DA(1),3,0)="^452.889ID^^"
SET DIC="^PRSE(452.8,DA(1),3,"
SET DIC(0)="AEQML"
DO ^DIC
IF +Y'>0
Begin DoDot:1
+3 WRITE $CHAR(7),!!,?5,"The START DATE is required to enter this class in the Registration File.",!
+4 QUIT
End DoDot:1
+5 SET Y=DA(1)
KILL DA(1),DIC
+6 QUIT
+7 ; 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
+1 SET XX=+^PRSE(452.8,+Y,0)
IF '$ORDER(^PRSE(452.8,+Y,3,0))
WRITE $CHAR(7),!,?5,"<"_$PIECE(^PRSE(452.1,XX,0),U)_"> DELETED !"
SET DA=+Y
SET DIK="^PRSE(452.8,"
DO ^DIK
SET POUT=1
SET Y=0
IF (+PRSENEW>0)
SET DA=XX
SET DIK="^PRSE(452.1,"
DO ^DIK
KILL DIK,PRSENEW
SET X=""
+2 QUIT
EN9 ; INPUT TRANSFORM FOR .01-1 SUBFIELDS OF FIELD 89 IN FILE 452.8
+1 SET PRSE(0)=$SELECT($DATA(^PRSE(452.8,DA(1),3,DA,0)):^(0),1:"")
SET PRSE("HELP")="DATE MUST BE "_$SELECT(PRSE="S":"EQUAL OR EARLIER THAN DATE ENDED ",1:"EQUAL OR LATER THAN DATE STARTED ")
SET %DT(0)=""
+2 IF PRSE="S"
IF (+$PIECE(PRSE(0),U,3)>0)
SET PRSE(1)=+$PIECE(PRSE(0),U,3)
SET %DT(0)=$SELECT((+$PIECE(PRSE(1),".",2)>0):"-"_+PRSE(1),1:"-"_+PRSE(1)_"."_+$PIECE(X,".",2))
+3 IF PRSE="E"
IF (+$PIECE(PRSE(0),U)>0)
SET PRSE(1)=+PRSE(0)
SET %DT(0)=$SELECT((+$PIECE(PRSE(1),".",2)>0):+PRSE(1),1:+PRSE(1)_"."_+$PIECE(X,".",2))
+4 if %DT(0)=""
KILL %DT(0)
SET %DT="TE"
DO ^%DT
SET X=Y
IF Y<1
WRITE !?5,PRSE("HELP")
KILL X
+5 KILL %DT,PRSE
+6 QUIT
EN10 ;INPUT TRANSFORM FOR 2-13 FIELDS OF FILE 452
+1 SET PRSE(0)=$SELECT($DATA(^PRSE(452,DA,0)):^(0),1:"")
SET PRSE("HELP")="DATE MUST BE "_$SELECT(PRSE="S":"EQUAL OR EARLIER THAN DATE ENDED ",1:"EQUAL OR LATER THAN DATE STARTED ")
SET %DT(0)=""
+2 IF PRSE="S"
IF (+$PIECE(PRSE(0),U,14)>0)
SET PRSE(1)=+$PIECE(PRSE(0),U,14)
SET %DT(0)=$SELECT((+$PIECE(PRSE(1),".",2)>0):"-"_+PRSE(1),1:"-"_+PRSE(1)_"."_+$PIECE(X,".",2))
+3 IF PRSE="E"
IF (+$PIECE(PRSE(0),U,3)>0)
SET PRSE(1)=+$PIECE(PRSE(0),U,3)
SET %DT(0)=$SELECT((+$PIECE(PRSE(1),".",2)>0):+PRSE(1),1:+PRSE(1)_"."_+$PIECE(X,".",2))
+4 if %DT(0)=""
KILL %DT(0)
SET %DT="QTE"
DO ^%DT
SET X=Y
IF Y<1
WRITE !?5,PRSE("HELP")
KILL X
+5 KILL %DT,PRSE
+6 QUIT
EN12(PRCOD) ; TITLE
+1 NEW Y
SET Y=PRCOD
DO OST^PRSDUTIL
SET ZZZ=$GET(Y)
+2 QUIT ZZZ
EN13(COSTCEN) ; LOCATION
+1 SET PRSELOC=""
IF COSTCEN'=""
SET PRSELOC=$ORDER(^PRSP(454,1,"CC","B",COSTCEN,0))
IF PRSELOC'=""
SET PRSELOC=$PIECE($GET(^PRSP(454,1,"CC",PRSELOC,0)),U,2)
+2 QUIT PRSELOC
