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 Dec 13, 2024@02:26:47 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
