- PRSEPOL0 ;HISC/DAD,MD-OLDE TRAINING CODING REPORT ;3/31/94
- ;;4.0;PAID;;Sep 21, 1995
- EN1 ; ENTRY POINT FROM OPTION
- S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
- D EN2^PRSEUTL3($G(DUZ))
- I PRSESER'>0,'(DUZ(0)="@") D MSG3^PRSEMSG S PRSEQUIT=1 G EXIT
- K PSP,PSPC S PSPC=PRSESER,PSPC("TX")=PRSESER("TX"),PSP=0
- I (DUZ(0)["@"!(+$$EN4^PRSEUTL3($G(DUZ)))) D G:PRSEQUIT EXIT
- . K POUT D EN3^PRSEUTL1 S PRSEQUIT=$S($D(POUT):1,1:0)
- . S PSP=+$G(PSP),PSPC("TX")=$G(PSPC),PSPC=+$G(PSPC(1))
- . Q
- I PSP S PRSESEL="A" G CONT
- SELECT K DIR S DIR(0)="SO^A:(A)ll Employees For a Service;S:(S)elected Service Employees",DIR("A")="Select ASSIGNMENT OPTION" D ^DIR
- S PRSESEL=Y I $D(DIRUT) S PRSEQUIT=1 G EXIT
- I PRSESEL="S" W ! K PRSEXMY F S Y=-1 W !,$S($O(PRSEXMY(0))>0:"Select Another Employee: ",1:"Select EMPLOYEE: ") R X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:(Y<0)
- . I X["?" D
- .. D MSG21^PRSEMSG I '($O(PRSEXMY(0))>0) S Y=1
- .. I Y'=1 D MSG2^PRSEMSG S Y=1
- .. Q
- . S PRSEN=0 S:"'-"[$E(X) X=$E(X,2,999),PRSEN=1
- . S DIC("S")="I $P($G(^PRSPC(+Y,1)),U,33)'=""Y"",$S($G(PSPC)&($G(PSPC(""TX""))=$$EN2^PRSEUTL4(+$G(Y))):1,1:"""")"
- . S DIC="^PRSPC(",DIC(0)="ZEQ" D ^DIC K DIC I Y'>0,X]"" S Y=0 Q
- . I Y>0,PRSEN W $S($D(PRSEXMY(+Y)):" Deleted.",1:" Not selected.") K PRSEXMY(+Y) Q
- . S (X,PRSEXMY(+Y))=""
- . Q
- I PRSESEL="S",'$D(PRSEXMY) S PRSEQUIT=1 G EXIT
- CONT ;
- K POUT S DATSEL="N+" D DATSEL^PRSEUTL I $D(POUT) S PRSEQUIT=1 G EXIT
- K DIR S DIR(0)="SOM^C:Complete records;I:Incomplete records;"
- S DIR("A")="Select records to print"
- S DIR("?",1)="'Complete' will only print those records with full OLDE data."
- S DIR("?",2)="'Incomplete' will only print those records without full OLDE data."
- S DIR("?")=" Enter either 'Complete' or 'Incomplete'."
- D ^DIR S PRSETYPE=Y I $D(DIRUT) S PRSEQUIT=1 G EXIT
- DEV ;
- S ZTRTN="ENTSK^PRSEPOL1" S (ZTSAVE("PSP"),ZTSAVE("PRSESEL"),ZTSAVE("PRSEXMY("),ZTSAVE("PSPC("),ZTSAVE("PYR"),ZTSAVE("TYP"),ZTSAVE("YRST("),ZTSAVE("YREND("),ZTSAVE("PSPC"),ZTSAVE("YRST"),ZTSAVE("YREND"),ZTSAVE("PRSETYPE"))=""
- S ZTDESC="Education Tracking report for OLDE training coding input"
- K %ZIS,IOP D DEV^PRSEUTL G:POP!($D(ZTSK)) EXIT
- D ENTSK^PRSEPOL1
- EXIT ;
- S POUT=$G(PRSEQUIT) D CLOSE^PRSEUTL
- K ^TMP("PRSE",$J) D ^PRSEKILL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEPOL0 2302 printed Mar 13, 2025@21:31:50 Page 2
- PRSEPOL0 ;HISC/DAD,MD-OLDE TRAINING CODING REPORT ;3/31/94
- +1 ;;4.0;PAID;;Sep 21, 1995
- EN1 ; ENTRY POINT FROM OPTION
- +1 SET X=$GET(^PRSE(452.7,1,"OFF"))
- IF X=""!(X=1)
- DO MSG6^PRSEMSG
- QUIT
- +2 DO EN2^PRSEUTL3($GET(DUZ))
- +3 IF PRSESER'>0
- IF '(DUZ(0)="@")
- DO MSG3^PRSEMSG
- SET PRSEQUIT=1
- GOTO EXIT
- +4 KILL PSP,PSPC
- SET PSPC=PRSESER
- SET PSPC("TX")=PRSESER("TX")
- SET PSP=0
- +5 IF (DUZ(0)["@"!(+$$EN4^PRSEUTL3($GET(DUZ))))
- Begin DoDot:1
- +6 KILL POUT
- DO EN3^PRSEUTL1
- SET PRSEQUIT=$SELECT($DATA(POUT):1,1:0)
- +7 SET PSP=+$GET(PSP)
- SET PSPC("TX")=$GET(PSPC)
- SET PSPC=+$GET(PSPC(1))
- +8 QUIT
- End DoDot:1
- if PRSEQUIT
- GOTO EXIT
- +9 IF PSP
- SET PRSESEL="A"
- GOTO CONT
- SELECT KILL DIR
- SET DIR(0)="SO^A:(A)ll Employees For a Service;S:(S)elected Service Employees"
- SET DIR("A")="Select ASSIGNMENT OPTION"
- DO ^DIR
- +1 SET PRSESEL=Y
- IF $DATA(DIRUT)
- SET PRSEQUIT=1
- GOTO EXIT
- +2 IF PRSESEL="S"
- WRITE !
- KILL PRSEXMY
- FOR
- SET Y=-1
- WRITE !,$SELECT($ORDER(PRSEXMY(0))>0:"Select Another Employee: ",1:"Select EMPLOYEE: ")
- READ X:DTIME
- if '$TEST
- SET X="^^"
- if X=""
- SET Y=""
- if "^^"[X
- QUIT
- Begin DoDot:1
- +3 IF X["?"
- Begin DoDot:2
- +4 DO MSG21^PRSEMSG
- IF '($ORDER(PRSEXMY(0))>0)
- SET Y=1
- +5 IF Y'=1
- DO MSG2^PRSEMSG
- SET Y=1
- +6 QUIT
- End DoDot:2
- +7 SET PRSEN=0
- if "'-"[$EXTRACT(X)
- SET X=$EXTRACT(X,2,999)
- SET PRSEN=1
- +8 SET DIC("S")="I $P($G(^PRSPC(+Y,1)),U,33)'=""Y"",$S($G(PSPC)&($G(PSPC(""TX""))=$$EN2^PRSEUTL4(+$G(Y))):1,1:"""")"
- +9 SET DIC="^PRSPC("
- SET DIC(0)="ZEQ"
- DO ^DIC
- KILL DIC
- IF Y'>0
- IF X]""
- SET Y=0
- QUIT
- +10 IF Y>0
- IF PRSEN
- WRITE $SELECT($DATA(PRSEXMY(+Y)):" Deleted.",1:" Not selected.")
- KILL PRSEXMY(+Y)
- QUIT
- +11 SET (X,PRSEXMY(+Y))=""
- +12 QUIT
- End DoDot:1
- if (Y<0)
- QUIT
- +13 IF PRSESEL="S"
- IF '$DATA(PRSEXMY)
- SET PRSEQUIT=1
- GOTO EXIT
- CONT ;
- +1 KILL POUT
- SET DATSEL="N+"
- DO DATSEL^PRSEUTL
- IF $DATA(POUT)
- SET PRSEQUIT=1
- GOTO EXIT
- +2 KILL DIR
- SET DIR(0)="SOM^C:Complete records;I:Incomplete records;"
- +3 SET DIR("A")="Select records to print"
- +4 SET DIR("?",1)="'Complete' will only print those records with full OLDE data."
- +5 SET DIR("?",2)="'Incomplete' will only print those records without full OLDE data."
- +6 SET DIR("?")=" Enter either 'Complete' or 'Incomplete'."
- +7 DO ^DIR
- SET PRSETYPE=Y
- IF $DATA(DIRUT)
- SET PRSEQUIT=1
- GOTO EXIT
- DEV ;
- +1 SET ZTRTN="ENTSK^PRSEPOL1"
- SET (ZTSAVE("PSP"),ZTSAVE("PRSESEL"),ZTSAVE("PRSEXMY("),ZTSAVE("PSPC("),ZTSAVE("PYR"),ZTSAVE("TYP"),ZTSAVE("YRST("),ZTSAVE("YREND("),ZTSAVE("PSPC"),ZTSAVE("YRST"),ZTSAVE("YREND"),ZTSAVE("PRSETYPE"))=""
- +2 SET ZTDESC="Education Tracking report for OLDE training coding input"
- +3 KILL %ZIS,IOP
- DO DEV^PRSEUTL
- if POP!($DATA(ZTSK))
- GOTO EXIT
- +4 DO ENTSK^PRSEPOL1
- EXIT ;
- +1 SET POUT=$GET(PRSEQUIT)
- DO CLOSE^PRSEUTL
- +2 KILL ^TMP("PRSE",$JOB)
- DO ^PRSEKILL
- +3 QUIT
