PRSEUTL3 ;HISC/JH/MD-EMPLOYEE EDUCATION REPORT - UTILITY ;8/10/99
;;4.0;PAID;**3,18,50**;Sep 21, 1995
EN1 ; DEFAULT FROM CLASS ROOM HOURS WHILE ON DUTY
S PRSW=0 I +$P($G(^PRSE(452.8,DA,0)),U,11)>0 S PRSW=1 Q
S XXX=PRSELEN,PRSELEN=$$EN5^PRSEUTL3($G(XXX)),$P(^PRSE(452.8,DA,0),U,11)=PRSELEN
Q
EN2(DUZ) ; USER SERVICE SELECTION ROUTINE
S (PRSESER,PDA,PRSE)=""
I $P($G(^VA(200,+$G(DUZ),1)),U,9)?9N S PRSE=$P(^(1),U,9)
I (PRSE>0) S PDA=+$O(^PRSPC("SSN",PRSE,0)) Q:$P($G(^PRSPC(+PDA,1)),U,33)="Y"
I +PDA>0 S $P(PRSE,U,2)=$P($G(^PRSPC(PDA,0)),U,49) I $P(PRSE,U,2)?8N S $P(PRSE,U,3)=$O(^PRSP(454,1,"ORG","B",$E($P(PRSE,U,2),1,4)_":"_$E($P(PRSE,U,2),5,8),0))
I $P($G(PRSE),U,3)>0 S PRSESER=$P(^PRSP(454,1,"ORG",$P(PRSE,U,3),0),U,2),PRSESER("TX")=$P($G(^PRSP(454.1,+PRSESER,0)),U)
I PRSESER="",+$$EN4^PRSEUTL3($G(DUZ)) S PRSESER=$O(^PRSP(454.1,"B","MISCELLANEOUS",0)),PRSESER("TX")=$P($G(^PRSP(454.1,+PRSESER,0)),U)
K PDA,PRSE
Q
EN3(PRDA) ; USER SERVICE SELECTION ROUTINE WITH NEW PERSON FILE POINTER
I '$G(PRDA) Q ""
N PRSEDATA S (XXX,PDA,PRSEDATA)=""
I $P($G(^VA(200,PRDA,1)),U,9)?9N S PRSEDATA=$P(^(1),U,9) S:$G(PRSEDATA)'="" PDA=$O(^PRSPC("SSN",PRSEDATA,0))
I +$G(PDA),$P($G(^PRSPC(PDA,1)),U,33)'="Y" S $P(PRSEDATA,U,2)=$P($G(^PRSPC(PDA,0)),U,49) I $P(PRSEDATA,U,2)?8N S $P(PRSEDATA,U,3)=$O(^PRSP(454,1,"ORG","B",$E($P(PRSEDATA,U,2),1,4)_":"_$E($P(PRSEDATA,U,2),5,8),0))
I +$P(PRSEDATA,U,3)>0 S XXX=$P(^PRSP(454,1,"ORG",+$P(PRSEDATA,U,3),0),U,2)
K PDA,PRSEDATA
Q XXX
SALCLS ; SETS AL_CLS XREF FOR FIELD 2 IN FILE 452
N PRSECLS
S PRSECLS=$P($G(^PRSE(452,DA,0)),U,2) Q:PRSECLS=""
I '$D(^PRSE(452,"AL"_PRSECLS,X)) S ^PRSE(452,"AL"_PRSECLS,X,DA)=""
Q
DALCLS ; KILLS AL_CLS XREF FOR FIELD 2 IN FILE 452
N PRSECLS,PRSEDT
S PRSECLS=$P($G(^PRSE(452,DA,0)),U,2) Q:PRSECLS=""
Q:'$D(^PRSE(452,"AL"_PRSECLS,X,DA))
S PRSEDT=0 F S PRSEDT=$O(^PRSE(452,"H",X,PRSEDT)) Q:PRSEDT'>0 I $P($G(^PRSE(452,PRSEDT,0)),U,2)=PRSECLS,PRSEDT'=DA Q
I PRSEDT>0 S ^PRSE(452,"AL"_PRSECLS,X,PRSEDT)=""
K ^PRSE(452,"AL"_PRSECLS,X,DA)
Q
SALCLS1 ; SETS AL_CLS XREF FOR FIELD 1 IN FILE 452
N PRSECLS1
S PRSECLS1=$P($G(^PRSE(452,DA,0)),U,3) Q:PRSECLS1=""
I '$D(^PRSE(452,"AL"_X,PRSECLS1)) S ^PRSE(452,"AL"_X,PRSECLS1,DA)=""
Q
DALCLS1 ; KILLS AL_CLS XREF FOR FIELD 1 IN FILE 452
N PRSECLS1,PRSEDT1
S PRSECLS1=$P($G(^PRSE(452,DA,0)),U,3) Q:PRSECLS1=""
Q:'$D(^PRSE(452,"AL"_X,PRSECLS1,DA))
S PRSEDT1=0 F S PRSEDT1=$O(^PRSE(452,"H",X,PRSEDT1)) Q:PRSEDT1'>0 I $P($G(^PRSE(452,PRSEDT1,0)),U,2)=PRSECLS1,PRSEDT1'=DA Q
I PRSEDT1>0 S ^PRSE(452,"AL"_X,PRSECLS1,PRSEDT1)=""
K ^PRSE(452,"AL"_X,PRSECLS1,DA)
Q
EN4(DUZ) ; PRSE-CORD SECURITY KEY CHECK
Q $S($D(^XUSEC("PRSE CORD",DUZ)):1,1:0)
EN5(XXX) ; ROUND VALUE IN VARIBLE XXX
S XXX=$J(XXX,1,0)
Q XXX
EN6(DUZ) ; PRSE SUP SECURITY KEY CHECK
Q $S($D(^XUSEC("PRSE SUP",DUZ)):1,1:0)
EN7(X,VA200DA,DA) ; DETERMINE THE SPONSORING SERVICE OF A CLASS
;I '$G(PRSXSW),$G(PRSELCL)="N" S PRSESVC="" G Q
S PRSEIEN=$O(^PRSE(452.1,"B",X,"")),PRSEIEN=$P($G(^PRSE(452.1,+PRSEIEN,0)),U,8),PRSEIEN(1)=$$EN3^PRSEUTL3($G(VA200DA))
S PRSESVC=$S($G(PRSEIEN)'="":PRSEIEN,$G(PRSEIEN(1))'="":PRSEIEN(1),1:+$O(^PRSP(454.1,"B","MISCELLANEOUS",0)))
Q Q PRSESVC
EN8(PRX) ; LATEST DATE
S PRSEDT=0 F XXX=0:0 S XXX=$O(^PRSE(452.8,PRX,3,"C",XXX)) Q:XXX'>0 I ((9999999-XXX)\1'>DT) N Y S Y=(9999999-XXX) D:+Y D^DIQ S PRSEDT=Y Q
Q PRSEDT
EN9(DUZ) ; PRSE TRAIN SECURITY KEY CHECK
Q $S($D(^XUSEC("PRSE TRAIN",DUZ)):1,1:0)
EN10(SSN) ; USER TITLE/OCCUPATION
N Y S XXX="",PRSDA=$O(^PRSPC("SSN",SSN,0))
I $P($G(^PRSPC(+PRSDA,0)),U,17)'="" S Y=$P(^(0),U,17) D OST^PRSDUTIL S XXX=$G(Y)
K PRSDA
Q XXX
EN11(X,D0) ; CHECK CLASS FILE FOR DUPLICATE NAME IF FOUND RETURN 1
N C,CLASS,IEN,PRSEDUP,Y K PRSEDUPL
S IEN=+$O(^PRSE(452.1,"B",X,0))
S PRSEDUP=$S(IEN'>0:0,IEN'=D0:1,1:0)
I PRSEDUP D
.S CLASS=$G(^PRSE(452.1,IEN,0))
.S PRSEDUPL(1)=""
.S PRSEDUPL(2)=" Duplicate class name found."
.S PRSEDUPL(3)=" Title: "_$S($P(CLASS,U)]"":$P(CLASS,U),1:"???")
.S Y=$P(CLASS,U,7),C=$P(^DD(452.1,5,0),U,2) D:Y]"" Y^DIQ
.S PRSEDUPL(4)=" Type: "_$S(Y]"":Y,1:"???")
.S PRSEDUPL(5)=" Service: "_$P($G(^PRSP(454.1,+$P($G(CLASS),U,8),0)),U,1)
Q PRSEDUP
EN12(D0) ; INPUT: D0 = File 200 IEN
; OUTPUT: 0 - No SSN found in file 200
; 1 - SSN found in file 200
N SSN
S SSN=$P($G(^VA(200,+D0,1)),U,9) S:SSN="" SSN=U
Q $S(SSN=U:0,1:1)
;
EN13(X) ; INPUT 'X' = internal entry # for file 200
; OUTPUT = internal entry # for file 450 or null
I $S('$G(X):1,'$D(^VA(200,+$G(X),450)):1,1:0) Q ""
Q +$G(^VA(200,+$G(X),450))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEUTL3 4651 printed Oct 16, 2024@18:27:38 Page 2
PRSEUTL3 ;HISC/JH/MD-EMPLOYEE EDUCATION REPORT - UTILITY ;8/10/99
+1 ;;4.0;PAID;**3,18,50**;Sep 21, 1995
EN1 ; DEFAULT FROM CLASS ROOM HOURS WHILE ON DUTY
+1 SET PRSW=0
IF +$PIECE($GET(^PRSE(452.8,DA,0)),U,11)>0
SET PRSW=1
QUIT
+2 SET XXX=PRSELEN
SET PRSELEN=$$EN5^PRSEUTL3($GET(XXX))
SET $PIECE(^PRSE(452.8,DA,0),U,11)=PRSELEN
+3 QUIT
EN2(DUZ) ; USER SERVICE SELECTION ROUTINE
+1 SET (PRSESER,PDA,PRSE)=""
+2 IF $PIECE($GET(^VA(200,+$GET(DUZ),1)),U,9)?9N
SET PRSE=$PIECE(^(1),U,9)
+3 IF (PRSE>0)
SET PDA=+$ORDER(^PRSPC("SSN",PRSE,0))
if $PIECE($GET(^PRSPC(+PDA,1)),U,33)="Y"
QUIT
+4 IF +PDA>0
SET $PIECE(PRSE,U,2)=$PIECE($GET(^PRSPC(PDA,0)),U,49)
IF $PIECE(PRSE,U,2)?8N
SET $PIECE(PRSE,U,3)=$ORDER(^PRSP(454,1,"ORG","B",$EXTRACT($PIECE(PRSE,U,2),1,4)_":"_$EXTRACT($PIECE(PRSE,U,2),5,8),0))
+5 IF $PIECE($GET(PRSE),U,3)>0
SET PRSESER=$PIECE(^PRSP(454,1,"ORG",$PIECE(PRSE,U,3),0),U,2)
SET PRSESER("TX")=$PIECE($GET(^PRSP(454.1,+PRSESER,0)),U)
+6 IF PRSESER=""
IF +$$EN4^PRSEUTL3($GET(DUZ))
SET PRSESER=$ORDER(^PRSP(454.1,"B","MISCELLANEOUS",0))
SET PRSESER("TX")=$PIECE($GET(^PRSP(454.1,+PRSESER,0)),U)
+7 KILL PDA,PRSE
+8 QUIT
EN3(PRDA) ; USER SERVICE SELECTION ROUTINE WITH NEW PERSON FILE POINTER
+1 IF '$GET(PRDA)
QUIT ""
+2 NEW PRSEDATA
SET (XXX,PDA,PRSEDATA)=""
+3 IF $PIECE($GET(^VA(200,PRDA,1)),U,9)?9N
SET PRSEDATA=$PIECE(^(1),U,9)
if $GET(PRSEDATA)'=""
SET PDA=$ORDER(^PRSPC("SSN",PRSEDATA,0))
+4 IF +$GET(PDA)
IF $PIECE($GET(^PRSPC(PDA,1)),U,33)'="Y"
SET $PIECE(PRSEDATA,U,2)=$PIECE($GET(^PRSPC(PDA,0)),U,49)
IF $PIECE(PRSEDATA,U,2)?8N
SET $PIECE(PRSEDATA,U,3)=$ORDER(^PRSP(454,1,"ORG","B",$EXTRACT($PIECE(PRSEDATA,U,2),1,4)_":"_$EXTRACT($PIECE(PRSEDATA,U,2),5,8),0))
+5 IF +$PIECE(PRSEDATA,U,3)>0
SET XXX=$PIECE(^PRSP(454,1,"ORG",+$PIECE(PRSEDATA,U,3),0),U,2)
+6 KILL PDA,PRSEDATA
+7 QUIT XXX
SALCLS ; SETS AL_CLS XREF FOR FIELD 2 IN FILE 452
+1 NEW PRSECLS
+2 SET PRSECLS=$PIECE($GET(^PRSE(452,DA,0)),U,2)
if PRSECLS=""
QUIT
+3 IF '$DATA(^PRSE(452,"AL"_PRSECLS,X))
SET ^PRSE(452,"AL"_PRSECLS,X,DA)=""
+4 QUIT
DALCLS ; KILLS AL_CLS XREF FOR FIELD 2 IN FILE 452
+1 NEW PRSECLS,PRSEDT
+2 SET PRSECLS=$PIECE($GET(^PRSE(452,DA,0)),U,2)
if PRSECLS=""
QUIT
+3 if '$DATA(^PRSE(452,"AL"_PRSECLS,X,DA))
QUIT
+4 SET PRSEDT=0
FOR
SET PRSEDT=$ORDER(^PRSE(452,"H",X,PRSEDT))
if PRSEDT'>0
QUIT
IF $PIECE($GET(^PRSE(452,PRSEDT,0)),U,2)=PRSECLS
IF PRSEDT'=DA
QUIT
+5 IF PRSEDT>0
SET ^PRSE(452,"AL"_PRSECLS,X,PRSEDT)=""
+6 KILL ^PRSE(452,"AL"_PRSECLS,X,DA)
+7 QUIT
SALCLS1 ; SETS AL_CLS XREF FOR FIELD 1 IN FILE 452
+1 NEW PRSECLS1
+2 SET PRSECLS1=$PIECE($GET(^PRSE(452,DA,0)),U,3)
if PRSECLS1=""
QUIT
+3 IF '$DATA(^PRSE(452,"AL"_X,PRSECLS1))
SET ^PRSE(452,"AL"_X,PRSECLS1,DA)=""
+4 QUIT
DALCLS1 ; KILLS AL_CLS XREF FOR FIELD 1 IN FILE 452
+1 NEW PRSECLS1,PRSEDT1
+2 SET PRSECLS1=$PIECE($GET(^PRSE(452,DA,0)),U,3)
if PRSECLS1=""
QUIT
+3 if '$DATA(^PRSE(452,"AL"_X,PRSECLS1,DA))
QUIT
+4 SET PRSEDT1=0
FOR
SET PRSEDT1=$ORDER(^PRSE(452,"H",X,PRSEDT1))
if PRSEDT1'>0
QUIT
IF $PIECE($GET(^PRSE(452,PRSEDT1,0)),U,2)=PRSECLS1
IF PRSEDT1'=DA
QUIT
+5 IF PRSEDT1>0
SET ^PRSE(452,"AL"_X,PRSECLS1,PRSEDT1)=""
+6 KILL ^PRSE(452,"AL"_X,PRSECLS1,DA)
+7 QUIT
EN4(DUZ) ; PRSE-CORD SECURITY KEY CHECK
+1 QUIT $SELECT($DATA(^XUSEC("PRSE CORD",DUZ)):1,1:0)
EN5(XXX) ; ROUND VALUE IN VARIBLE XXX
+1 SET XXX=$JUSTIFY(XXX,1,0)
+2 QUIT XXX
EN6(DUZ) ; PRSE SUP SECURITY KEY CHECK
+1 QUIT $SELECT($DATA(^XUSEC("PRSE SUP",DUZ)):1,1:0)
EN7(X,VA200DA,DA) ; DETERMINE THE SPONSORING SERVICE OF A CLASS
+1 ;I '$G(PRSXSW),$G(PRSELCL)="N" S PRSESVC="" G Q
+2 SET PRSEIEN=$ORDER(^PRSE(452.1,"B",X,""))
SET PRSEIEN=$PIECE($GET(^PRSE(452.1,+PRSEIEN,0)),U,8)
SET PRSEIEN(1)=$$EN3^PRSEUTL3($GET(VA200DA))
+3 SET PRSESVC=$SELECT($GET(PRSEIEN)'="":PRSEIEN,$GET(PRSEIEN(1))'="":PRSEIEN(1),1:+$ORDER(^PRSP(454.1,"B","MISCELLANEOUS",0)))
Q QUIT PRSESVC
EN8(PRX) ; LATEST 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)\1'>DT)
NEW Y
SET Y=(9999999-XXX)
if +Y
DO D^DIQ
SET PRSEDT=Y
QUIT
+2 QUIT PRSEDT
EN9(DUZ) ; PRSE TRAIN SECURITY KEY CHECK
+1 QUIT $SELECT($DATA(^XUSEC("PRSE TRAIN",DUZ)):1,1:0)
EN10(SSN) ; USER TITLE/OCCUPATION
+1 NEW Y
SET XXX=""
SET PRSDA=$ORDER(^PRSPC("SSN",SSN,0))
+2 IF $PIECE($GET(^PRSPC(+PRSDA,0)),U,17)'=""
SET Y=$PIECE(^(0),U,17)
DO OST^PRSDUTIL
SET XXX=$GET(Y)
+3 KILL PRSDA
+4 QUIT XXX
EN11(X,D0) ; CHECK CLASS FILE FOR DUPLICATE NAME IF FOUND RETURN 1
+1 NEW C,CLASS,IEN,PRSEDUP,Y
KILL PRSEDUPL
+2 SET IEN=+$ORDER(^PRSE(452.1,"B",X,0))
+3 SET PRSEDUP=$SELECT(IEN'>0:0,IEN'=D0:1,1:0)
+4 IF PRSEDUP
Begin DoDot:1
+5 SET CLASS=$GET(^PRSE(452.1,IEN,0))
+6 SET PRSEDUPL(1)=""
+7 SET PRSEDUPL(2)=" Duplicate class name found."
+8 SET PRSEDUPL(3)=" Title: "_$SELECT($PIECE(CLASS,U)]"":$PIECE(CLASS,U),1:"???")
+9 SET Y=$PIECE(CLASS,U,7)
SET C=$PIECE(^DD(452.1,5,0),U,2)
if Y]""
DO Y^DIQ
+10 SET PRSEDUPL(4)=" Type: "_$SELECT(Y]"":Y,1:"???")
+11 SET PRSEDUPL(5)=" Service: "_$PIECE($GET(^PRSP(454.1,+$PIECE($GET(CLASS),U,8),0)),U,1)
End DoDot:1
+12 QUIT PRSEDUP
EN12(D0) ; INPUT: D0 = File 200 IEN
+1 ; OUTPUT: 0 - No SSN found in file 200
+2 ; 1 - SSN found in file 200
+3 NEW SSN
+4 SET SSN=$PIECE($GET(^VA(200,+D0,1)),U,9)
if SSN=""
SET SSN=U
+5 QUIT $SELECT(SSN=U:0,1:1)
+6 ;
EN13(X) ; INPUT 'X' = internal entry # for file 200
+1 ; OUTPUT = internal entry # for file 450 or null
+2 IF $SELECT('$GET(X):1,'$DATA(^VA(200,+$GET(X),450)):1,1:0)
QUIT ""
+3 QUIT +$GET(^VA(200,+$GET(X),450))
