source: FOIAVistA/trunk/r/PAID-PRS/PRSEUTL3.m@ 1397

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))