PRSEED14 ;HISC/MD-E/E MI ATTENDANCE BY MULTIPLE EMPLOYEES ;JUN 93
;;4.0;PAID;**5,18,20**;Sep 21, 1995
EN1 ;PRSE-MI-MULT
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!X D MSG6^PRSEMSG Q
D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q1
K ^TMP("PRSE",$J),^TMP($J) S (NOUT,NSW)=0,(PRSEQWIK,PRSESW)=1,PRSESRCE="VA",PRSEGF="G",PRSELCL="L",PRSEPURP="IMPROVE PRESENT PERFORMANCE",PRSELOC=$P($G(^PRSE(452.7,1,0)),U,2),PRSECOD="N",PRSEROU="R"
S (PRSEBAD,NOUT,POUT)=0,Y=DT D D^DIQ S %DT("B")=Y
DT K POUT D DATE G Q1:$G(POUT)
MI S (NOUT,POUT)=0 K ^TMP("PRSE",$J),^TMP($J) S PRSESEL="M" D NAM^PRSEED1 I $D(POUT)!'($G(VA200DA)) G DT
S SSN=$P($G(^VA(200,+$G(VA200DA),1)),U,9),VA450DA=$O(^PRSPC("SSN",SSN,0)) S PRSESER("TX")=$P($G(^PRSP(454.1,+PRSESER,0)),U) I $G(PRSESER("TX"))="",(+$G(PRSPDA(1))>0) D MSG3^PRSEMSG G Q1
I '+$O(^PRSE(452.6,"B","MANDATORY TRAINING",0)) S:'$D(^PRSE(452.6,0)) ^(0)="PRSE SVC REASONS FOR TRAINING^452.6^0^0" S X="MANDATORY TRAINING",DIC(0)="L",DIC="^PRSE(452.6,",DLAYGO=452.6 K DD,DO D FILE^DICN
S PRSDA=0 D GRPEDT
G MI
Q1 D ^PRSEKILL K ^TMP("PRSE",$J),^TMP($J)
Q
DATE W ! S %DT("A")="Date Class Attended: ",%DT="AET",%DT(0)=-DT D ^%DT K %DT I Y<0 S POUT=1 Q
S (PRSEED,PRSEDT)=Y Q
GRPEDT ;CREDIT CLASSES
I '$O(^PRSPC(+VA450DA,6,0)),(+$G(PRSPDA(1))>0) W !?3,"NO MANDATORY CLASSES ASSIGNED TO THIS EMPLOYEE!!",! S DIR(0)="E" D ^DIR K DIR Q:Y'>0 D ASK1 Q
S DIK="^PRSPC(+VA450DA,6," F I=0:0 S I=$O(^PRSPC(+VA450DA,6,"B",I)) Q:I'>0 I $G(^PRSE(452.1,+I,0))=""!($P($G(^(0)),U,7)'="M") S DA(1)=VA450DA,DA=$O(^PRSPC(+VA450DA,6,"B",I,0)) D ^DIK
D DISP
STUFF S (PRSEII,NDA)=0 F S PRSEII=$O(^TMP("PRSE",$J,PRSEII)) Q:PRSEII'>0!($G(POUT)) S NDA=+$G(^TMP("PRSE",$J,PRSEII)) I $P($G(^PRSE(452.1,+NDA,0)),U)'="" S PRSENAM="`"_+NDA D
.S PRSELNG=+$P($G(^PRSE(452.1,NDA,0)),U,3),PRSDA=+$O(^PRSE(452.8,"B",NDA,0))
.S PRSECAT="" I ($P($G(^PRSE(452.1,NDA,0)),U,9)=0!($$EN3^PRSEUTL3($G(VA200DA))=$P($G(^PRSE(452.8,PRSDA,0)),U,21))) S PRSECAT=$P($G(^PRSE(452.4,+$P($G(^PRSE(452.8,PRSDA,0)),U,10),0)),U)
.W ! S (NSW,NDUPSW)=0 D RECHK^PRSEED7 Q:NOUT I 'NDUPSW W ! S DIC("S")="I $D(^PRSPC(VA450DA,6,""B"",+Y))" D ADD^PRSEED12 Q:$G(POUT) S NSW=1 W !?9,$P($G(^PRSE(452.1,+NDA,0)),U)," ",PRSESTUD," " S Y=PRSEDT D DT^DIQ
Q
ASK1 ;
I $D(^PRSE(452,"AA","M",VA200DA)) D NOMIHLP
ASK2 S NOUT=0 W ! S DIC=452.1,DIC(0)="AEQ",DIC("A")="Select Mandatory Training Class: ",DIC("S")="S PRS=^(0) I ($P(PRS,U,8)=PRSESER!($P(PRS,U,9)=0)),$P(PRS,U,7)=""M""" D ^DIC K DIC I $D(DTOUT)!($D(DUOUT))!("^^"[X) S NOUT=1 Q
I +Y'>0 G ASK1:X?1"?".E,ASK2
S PRSENAM="`"_+Y,PRSELNG=$P($G(^PRSE(452.1,+Y,0)),U,3),PRSDA=+$O(^PRSE(452.8,"B",+Y,0)),(NSW,NDUPSW)=0
S PRSECAT="" I ($P($G(^PRSE(452.1,+Y,0)),U,9)=0!($$EN3^PRSEUTL3($G(VA200DA))=$P($G(^PRSE(452.8,PRSDA,0)),U,21))) S PRSECAT=$P($G(^PRSE(452.4,+$P($G(^PRSE(452.8,PRSDA,0)),U,10),0)),U)
D RECHK^PRSEED7 G:NOUT ASK2 I 'NDUPSW D ADD^PRSEED12 Q:$G(POUT)
I 'NDUPSW,'NSW W !?9,PRSENAM(0)," ",PRSESTUD," " S Y=PRSEDT D DT^DIQ S NSW=1
Q
DISP K PRSETAB,PSV,PSVC S (PRSCLAS,PRSEMAX)=0,PRSCLAS(1)=""
F S PRSCLAS=$O(^PRSPC(+VA450DA,6,"B",PRSCLAS)) Q:PRSCLAS'>0 I $P($G(^PRSE(452.1,+PRSCLAS,0)),U)'="" S ^TMP($J,"PSV",$P($G(^(0)),U))=+PRSCLAS
F S PRSCLAS(1)=$O(^TMP($J,"PSV",PRSCLAS(1))) Q:PRSCLAS(1)="" S PRSEMAX=PRSEMAX+1,^TMP($J,"PSVC",PRSEMAX)=+^TMP($J,"PSV",PRSCLAS(1))_U_PRSCLAS(1)
S PRSEMAX=PRSEMAX+1,PRSESTRT=1,^TMP($J,"PSVC",PRSEMAX)="ALL^ALL"
F D DSP I $G(PRSEDONE)!$G(POUT) Q
Q
DSP ;
D HDR S PRSEAQ=$Y
F PRSE=PRSESTRT:1:PRSEMAX S PRSEI=PRSE,PRSETAB=4 D I $Y>(IOSL+PRSEAQ-7),PRSE'=PRSEMAX S PRSESTRT=PRSE+1 Q
.Q:$D(^TMP($J,"PSVC",PRSEI))[0
.W:PRSETAB=4 ! W:^TMP($J,"PSVC",PRSEI)'="" ?PRSETAB,$J(PRSEI,2),". ",$P($G(^TMP($J,"PSVC",PRSEI)),U,2) D LASTDAT
S PRSEDONE=(PRSE=PRSEMAX)
W:'PRSEDONE !,"<<More>>"
ASK ;
W !!,?5,"Select TRAINING Class(es) to be added: " R PRX:DTIME
I '$T!(PRX=U) S PRX=U I PRX[U S:$E(PRX)=U POUT=1 Q
I PRX=PRSEMAX!(PRX="A")!(PRX="ALL") D LOOP Q
D VALENT^PRSEED7 I (PRX["?"!(PRSEBAD)) G DSP:PRX?2."?",ASK
F PRSEI=1:1 S PRSECLA=$P(PRX,",",PRSEI) Q:PRSECLA="" S PRSESL=$P(PRSECLA,"-",2)_"+"_PRSECLA F PRSECNT=+PRSECLA:1:PRSESL I $D(^TMP($J,"PSVC",PRSECNT)) S ^TMP("PRSE",$J,PRSECNT)=+^TMP($J,"PSVC",PRSECNT)
Q
NOMIHLP ;
D HDR S DA(2)="" F S DA(2)=$O(^PRSE(452,"AA",PRSESEL,VA200DA,DA(2))) Q:DA(2)="" S D2=$O(^PRSE(452,"AA",PRSESEL,VA200DA,DA(2),0)) Q:D2'>0 D
.S D1=$O(^PRSE(452,"AA",PRSESEL,VA200DA,DA(2),D2,0)) Q:D1'>0 I $D(^PRSE(452,D1,0)),'($P(^(0),U,2)="") S PRSEDATA=^(0) D
..I $P(PRSEDATA,U,2)'="" W !?9,$P(PRSEDATA,U,2) S Y=(9999999-$O(^PRSE(452,"AA",PRSESEL,VA200DA,$P(PRSEDATA,U,2),""))) D D^DIQ W ?63,$E(Y,1,12)
Q
LASTDAT ;LAST ATTENDED
Q:$P($G(^TMP($J,"PSVC",+PRSEI)),U,2)="" I +$O(^PRSE(452,"AA",PRSESEL,VA200DA,$P(^TMP($J,"PSVC",PRSEI),U,2),0))>0 S Y=(9999999-$O(^PRSE(452,"AA",PRSESEL,VA200DA,$P(^TMP($J,"PSVC",PRSEI),U,2),0))) D D^DIQ W ?63,$E(Y,1,12)
Q
HDR K X S $P(X,"-",80)="" W @IOF,!,?1,"MANDATORY TRAINING CLASS",?60,"DATE LAST ATTENDED",!,X,!
Q
LOOP S PRSEI=0 F S PRSEI=$O(^TMP($J,"PSVC",PRSEI)) Q:PRSEI>(PRSEMAX-1) I $D(^TMP($J,"PSVC",PRSEI)) S ^TMP("PRSE",$J,+PRSEI)=+^TMP($J,"PSVC",PRSEI)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEED14 5200 printed Apr 09, 2024@21:25:54 Page 2
PRSEED14 ;HISC/MD-E/E MI ATTENDANCE BY MULTIPLE EMPLOYEES ;JUN 93
+1 ;;4.0;PAID;**5,18,20**;Sep 21, 1995
EN1 ;PRSE-MI-MULT
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!X
DO MSG6^PRSEMSG
QUIT
+2 DO EN2^PRSEUTL3($GET(DUZ))
IF PRSESER=""&'(DUZ(0)="@")
DO MSG3^PRSEMSG
GOTO Q1
+3 KILL ^TMP("PRSE",$JOB),^TMP($JOB)
SET (NOUT,NSW)=0
SET (PRSEQWIK,PRSESW)=1
SET PRSESRCE="VA"
SET PRSEGF="G"
SET PRSELCL="L"
SET PRSEPURP="IMPROVE PRESENT PERFORMANCE"
SET PRSELOC=$PIECE($GET(^PRSE(452.7,1,0)),U,2)
SET PRSECOD="N"
SET PRSEROU="R"
+4 SET (PRSEBAD,NOUT,POUT)=0
SET Y=DT
DO D^DIQ
SET %DT("B")=Y
DT KILL POUT
DO DATE
if $GET(POUT)
GOTO Q1
MI SET (NOUT,POUT)=0
KILL ^TMP("PRSE",$JOB),^TMP($JOB)
SET PRSESEL="M"
DO NAM^PRSEED1
IF $DATA(POUT)!'($GET(VA200DA))
GOTO DT
+1 SET SSN=$PIECE($GET(^VA(200,+$GET(VA200DA),1)),U,9)
SET VA450DA=$ORDER(^PRSPC("SSN",SSN,0))
SET PRSESER("TX")=$PIECE($GET(^PRSP(454.1,+PRSESER,0)),U)
IF $GET(PRSESER("TX"))=""
IF (+$GET(PRSPDA(1))>0)
DO MSG3^PRSEMSG
GOTO Q1
+2 IF '+$ORDER(^PRSE(452.6,"B","MANDATORY TRAINING",0))
if '$DATA(^PRSE(452.6,0))
SET ^(0)="PRSE SVC REASONS FOR TRAINING^452.6^0^0"
SET X="MANDATORY TRAINING"
SET DIC(0)="L"
SET DIC="^PRSE(452.6,"
SET DLAYGO=452.6
KILL DD,DO
DO FILE^DICN
+3 SET PRSDA=0
DO GRPEDT
+4 GOTO MI
Q1 DO ^PRSEKILL
KILL ^TMP("PRSE",$JOB),^TMP($JOB)
+1 QUIT
DATE WRITE !
SET %DT("A")="Date Class Attended: "
SET %DT="AET"
SET %DT(0)=-DT
DO ^%DT
KILL %DT
IF Y<0
SET POUT=1
QUIT
+1 SET (PRSEED,PRSEDT)=Y
QUIT
GRPEDT ;CREDIT CLASSES
+1 IF '$ORDER(^PRSPC(+VA450DA,6,0))
IF (+$GET(PRSPDA(1))>0)
WRITE !?3,"NO MANDATORY CLASSES ASSIGNED TO THIS EMPLOYEE!!",!
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y'>0
QUIT
DO ASK1
QUIT
+2 SET DIK="^PRSPC(+VA450DA,6,"
FOR I=0:0
SET I=$ORDER(^PRSPC(+VA450DA,6,"B",I))
if I'>0
QUIT
IF $GET(^PRSE(452.1,+I,0))=""!($PIECE($GET(^(0)),U,7)'="M")
SET DA(1)=VA450DA
SET DA=$ORDER(^PRSPC(+VA450DA,6,"B",I,0))
DO ^DIK
+3 DO DISP
STUFF SET (PRSEII,NDA)=0
FOR
SET PRSEII=$ORDER(^TMP("PRSE",$JOB,PRSEII))
if PRSEII'>0!($GET(POUT))
QUIT
SET NDA=+$GET(^TMP("PRSE",$JOB,PRSEII))
IF $PIECE($GET(^PRSE(452.1,+NDA,0)),U)'=""
SET PRSENAM="`"_+NDA
Begin DoDot:1
+1 SET PRSELNG=+$PIECE($GET(^PRSE(452.1,NDA,0)),U,3)
SET PRSDA=+$ORDER(^PRSE(452.8,"B",NDA,0))
+2 SET PRSECAT=""
IF ($PIECE($GET(^PRSE(452.1,NDA,0)),U,9)=0!($$EN3^PRSEUTL3($GET(VA200DA))=$PIECE($GET(^PRSE(452.8,PRSDA,0)),U,21)))
SET PRSECAT=$PIECE($GET(^PRSE(452.4,+$PIECE($GET(^PRSE(452.8,PRSDA,0)),U,10),0)),U)
+3 WRITE !
SET (NSW,NDUPSW)=0
DO RECHK^PRSEED7
if NOUT
QUIT
IF 'NDUPSW
WRITE !
SET DIC("S")="I $D(^PRSPC(VA450DA,6,""B"",+Y))"
DO ADD^PRSEED12
if $GET(POUT)
QUIT
SET NSW=1
WRITE !?9,$PIECE($GET(^PRSE(452.1,+NDA,0)),U)," ",PRSESTUD," "
SET Y=PRSEDT
DO DT^DIQ
End DoDot:1
+4 QUIT
ASK1 ;
+1 IF $DATA(^PRSE(452,"AA","M",VA200DA))
DO NOMIHLP
ASK2 SET NOUT=0
WRITE !
SET DIC=452.1
SET DIC(0)="AEQ"
SET DIC("A")="Select Mandatory Training Class: "
SET DIC("S")="S PRS=^(0) I ($P(PRS,U,8)=PRSESER!($P(PRS,U,9)=0)),$P(PRS,U,7)=""M"""
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))!("^^"[X)
SET NOUT=1
QUIT
+1 IF +Y'>0
if X?1"?".E
GOTO ASK1
GOTO ASK2
+2 SET PRSENAM="`"_+Y
SET PRSELNG=$PIECE($GET(^PRSE(452.1,+Y,0)),U,3)
SET PRSDA=+$ORDER(^PRSE(452.8,"B",+Y,0))
SET (NSW,NDUPSW)=0
+3 SET PRSECAT=""
IF ($PIECE($GET(^PRSE(452.1,+Y,0)),U,9)=0!($$EN3^PRSEUTL3($GET(VA200DA))=$PIECE($GET(^PRSE(452.8,PRSDA,0)),U,21)))
SET PRSECAT=$PIECE($GET(^PRSE(452.4,+$PIECE($GET(^PRSE(452.8,PRSDA,0)),U,10),0)),U)
+4 DO RECHK^PRSEED7
if NOUT
GOTO ASK2
IF 'NDUPSW
DO ADD^PRSEED12
if $GET(POUT)
QUIT
+5 IF 'NDUPSW
IF 'NSW
WRITE !?9,PRSENAM(0)," ",PRSESTUD," "
SET Y=PRSEDT
DO DT^DIQ
SET NSW=1
+6 QUIT
DISP KILL PRSETAB,PSV,PSVC
SET (PRSCLAS,PRSEMAX)=0
SET PRSCLAS(1)=""
+1 FOR
SET PRSCLAS=$ORDER(^PRSPC(+VA450DA,6,"B",PRSCLAS))
if PRSCLAS'>0
QUIT
IF $PIECE($GET(^PRSE(452.1,+PRSCLAS,0)),U)'=""
SET ^TMP($JOB,"PSV",$PIECE($GET(^(0)),U))=+PRSCLAS
+2 FOR
SET PRSCLAS(1)=$ORDER(^TMP($JOB,"PSV",PRSCLAS(1)))
if PRSCLAS(1)=""
QUIT
SET PRSEMAX=PRSEMAX+1
SET ^TMP($JOB,"PSVC",PRSEMAX)=+^TMP($JOB,"PSV",PRSCLAS(1))_U_PRSCLAS(1)
+3 SET PRSEMAX=PRSEMAX+1
SET PRSESTRT=1
SET ^TMP($JOB,"PSVC",PRSEMAX)="ALL^ALL"
+4 FOR
DO DSP
IF $GET(PRSEDONE)!$GET(POUT)
QUIT
+5 QUIT
DSP ;
+1 DO HDR
SET PRSEAQ=$Y
+2 FOR PRSE=PRSESTRT:1:PRSEMAX
SET PRSEI=PRSE
SET PRSETAB=4
Begin DoDot:1
+3 if $DATA(^TMP($JOB,"PSVC",PRSEI))[0
QUIT
+4 if PRSETAB=4
WRITE !
if ^TMP($JOB,"PSVC",PRSEI)'=""
WRITE ?PRSETAB,$JUSTIFY(PRSEI,2),". ",$PIECE($GET(^TMP($JOB,"PSVC",PRSEI)),U,2)
DO LASTDAT
End DoDot:1
IF $Y>(IOSL+PRSEAQ-7)
IF PRSE'=PRSEMAX
SET PRSESTRT=PRSE+1
QUIT
+5 SET PRSEDONE=(PRSE=PRSEMAX)
+6 if 'PRSEDONE
WRITE !,"<<More>>"
ASK ;
+1 WRITE !!,?5,"Select TRAINING Class(es) to be added: "
READ PRX:DTIME
+2 IF '$TEST!(PRX=U)
SET PRX=U
IF PRX[U
if $EXTRACT(PRX)=U
SET POUT=1
QUIT
+3 IF PRX=PRSEMAX!(PRX="A")!(PRX="ALL")
DO LOOP
QUIT
+4 DO VALENT^PRSEED7
IF (PRX["?"!(PRSEBAD))
if PRX?2."?"
GOTO DSP
GOTO ASK
+5 FOR PRSEI=1:1
SET PRSECLA=$PIECE(PRX,",",PRSEI)
if PRSECLA=""
QUIT
SET PRSESL=$PIECE(PRSECLA,"-",2)_"+"_PRSECLA
FOR PRSECNT=+PRSECLA:1:PRSESL
IF $DATA(^TMP($JOB,"PSVC",PRSECNT))
SET ^TMP("PRSE",$JOB,PRSECNT)=+^TMP($JOB,"PSVC",PRSECNT)
+6 QUIT
NOMIHLP ;
+1 DO HDR
SET DA(2)=""
FOR
SET DA(2)=$ORDER(^PRSE(452,"AA",PRSESEL,VA200DA,DA(2)))
if DA(2)=""
QUIT
SET D2=$ORDER(^PRSE(452,"AA",PRSESEL,VA200DA,DA(2),0))
if D2'>0
QUIT
Begin DoDot:1
+2 SET D1=$ORDER(^PRSE(452,"AA",PRSESEL,VA200DA,DA(2),D2,0))
if D1'>0
QUIT
IF $DATA(^PRSE(452,D1,0))
IF '($PIECE(^(0),U,2)="")
SET PRSEDATA=^(0)
Begin DoDot:2
+3 IF $PIECE(PRSEDATA,U,2)'=""
WRITE !?9,$PIECE(PRSEDATA,U,2)
SET Y=(9999999-$ORDER(^PRSE(452,"AA",PRSESEL,VA200DA,$PIECE(PRSEDATA,U,2),"")))
DO D^DIQ
WRITE ?63,$EXTRACT(Y,1,12)
End DoDot:2
End DoDot:1
+4 QUIT
LASTDAT ;LAST ATTENDED
+1 if $PIECE($GET(^TMP($JOB,"PSVC",+PRSEI)),U,2)=""
QUIT
IF +$ORDER(^PRSE(452,"AA",PRSESEL,VA200DA,$PIECE(^TMP($JOB,"PSVC",PRSEI),U,2),0))>0
SET Y=(9999999-$ORDER(^PRSE(452,"AA",PRSESEL,VA200DA,$PIECE(^TMP($JOB,"PSVC",PRSEI),U,2),0)))
DO D^DIQ
WRITE ?63,$EXTRACT(Y,1,12)
+2 QUIT
HDR KILL X
SET $PIECE(X,"-",80)=""
WRITE @IOF,!,?1,"MANDATORY TRAINING CLASS",?60,"DATE LAST ATTENDED",!,X,!
+1 QUIT
LOOP SET PRSEI=0
FOR
SET PRSEI=$ORDER(^TMP($JOB,"PSVC",PRSEI))
if PRSEI>(PRSEMAX-1)
QUIT
IF $DATA(^TMP($JOB,"PSVC",PRSEI))
SET ^TMP("PRSE",$JOB,+PRSEI)=+^TMP($JOB,"PSVC",PRSEI)
+1 QUIT
