PRSEPOL1 ;HISC/DAD,MD-OLDE TRAINING CODING REPORT ;8/26/94 09:34
;;4.0;PAID;**18**;Sep 21, 1995
ENTSK ;
K ^TMP("PRSE",$J)
S PRSEDATE=YRST-.0000001
F S PRSEDATE=$O(^PRSE(452,"H",PRSEDATE)) Q:PRSEDATE'>0!(PRSEDATE>YREND) D
. S PRSED0=0
. F S PRSED0=$O(^PRSE(452,"H",PRSEDATE,PRSED0)) Q:PRSED0'>0 D
.. S PRSE=$G(^PRSE(452,PRSED0,0))
.. S PRSE200=+PRSE,PRSESSN=$P(PRSE,U,11) Q:PRSE200'>0!(PRSESSN="")
.. I PRSESEL="S",$D(PRSEXMY(+$$EN13^PRSEUTL3(PRSE200)))#2 D Q
... S ^TMP("PRSE",$J,PRSESSN,PRSED0)=""
... Q
.. I PRSESEL="A",($$EN2^PRSEUTL4(+$$EN13^PRSEUTL3(PRSE200))=PSPC("TX")!PSP) D Q
... S ^TMP("PRSE",$J,PRSESSN,PRSED0)=""
... Q
.. Q
. Q
S PRSEQUIT=0,PRSEPAGE=1,PRSEUNDL="",$P(PRSEUNDL,"-",81)=""
S Y=DT D DD^%DT S PRSENOW=Y
K PRSETXT
F PRSE=1:1 S PRSETXT=$P($T(DATA+PRSE),";",3) Q:PRSETXT="" D
. S PRSETXT(PRSE)=PRSETXT_":"
. Q
U IO D HEADER
S (PRSESSN,PRSEPRNT)=0
F S PRSESSN=$O(^TMP("PRSE",$J,PRSESSN)) Q:PRSESSN'>0!PRSEQUIT D
. S PRSED0=0
. F S PRSED0=$O(^TMP("PRSE",$J,PRSESSN,PRSED0)) Q:PRSED0'>0!PRSEQUIT D GETDATA
. Q
I PRSEPRNT'>0 W !!,"No data found for this report"
Q
GETDATA ;
K PRSEDATA
S PRSE(0)=$G(^PRSE(452,PRSED0,0)),PRSE(2)=$G(^(2)),PRSE(6)=$G(^(6))
I $P(PRSE(0),U,12)'="Y" Q ; *** 'CODE FOR OLDE' not set to 'YES'
S PRSETYED=$P(PRSE(0),U,21) I "^C^M^O^"'[(U_PRSETYED_U) Q ; Type=C/M/O
S PRSEDATA(1)=$P(PRSE(0),U,11)
S PRSEDATA(1)=$E("000000000",1,9-$L(PRSEDATA(1)))_PRSEDATA(1)
S (Y,PRSEY)=$P(PRSE(0),U),C=$P(^DD(452,.01,0),U,2)
I Y]"" D Y^DIQ I Y]"" D
. S X=$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3(+PRSEY),0)),U)
. S PRSEDATA(2)=Y_" - "_$S(X]"":X,1:"UNKNOWN")
. Q
S (PRSEDATA,Y)=$P(PRSE(0),U,22),C=$P(^DD(452,15,0),U,2)
I Y]"" D Y^DIQ I Y]"" S PRSEDATA(3)=PRSEDATA_" ("_Y_")"
S Y=$P(PRSE(2),U)
S X=$G(^PRSE(452.51,+Y,0)),X(1)=$P(X,U),X(2)=$P(X,U,2)
I X(1)]"",X(2)]"" S PRSEDATA(4)=X(2)_" ("_X(1)_")"
S (PRSEDATA,Y)=$P(PRSE(0),U,7),C=$P(^DD(452,6,0),U,2)
I Y]"" D Y^DIQ I Y]"" S PRSEDATA(5)=PRSEDATA_" ("_Y_")"
S Y=$P(PRSE(0),U,5)
S X=$G(^PRSE(452.4,+Y,0)),X(1)=$P(X,U),X(2)=$P(X,U,2)
I X(1)]"",X(2)]"" S PRSEDATA(6)=X(2)_" ("_X(1)_")"
S Y=$P(PRSE(0),U,2),C=$P(^DD(452,1,0),U,2)
I Y]"" D Y^DIQ I Y]"" S PRSEDATA(7)=Y_" ("_PRSETYED_")"
S Y=$P(PRSE(0),U,14)
S PRSEDATA(8)=$S(Y:$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),1:"")
S PRSEDATA(9)=$P(PRSE(0),U,23)
I PRSEDATA(9)]"" S PRSEDATA(9)=$J($FN(PRSEDATA(9),","),5)
S PRSEDATA(10)=$P(PRSE(0),U,24)
I PRSEDATA(10)]"" S PRSEDATA(10)=$J($FN(PRSEDATA(10),","),5)
S Y=$P(PRSE(0),U,4),PRSEY=$TR(Y,"NR","AB"),C=$P(^DD(452,20,0),U,2)
I Y]"" D Y^DIQ I Y]"" S PRSEDATA(11)=PRSEY_" ("_Y_")"
S Y=$P(PRSE(0),U,19) I $P(PRSE(6),U)="L",PRSETYED="C" S Y=+Y
I Y]"" S PRSEDATA(12)=$J($FN(Y,",",2),8)
S Y=$P(PRSE(0),U,20) I $P(PRSE(6),U)="L",PRSETYED="C" S Y=+Y
I Y]"" S PRSEDATA(13)=$J($FN(Y,",",2),8)
S Y=$P(PRSE(0),U,8) I $P(PRSE(6),U)="L",PRSETYED="C" S Y=+Y
I Y]"" S PRSEDATA(14)=$J($FN(Y,",",2),8)
S Y=$P(PRSE(0),U,9),C=$P(^DD(452,8,0),U,2)
I Y]"" D Y^DIQ I Y]"" S PRSEDATA(15)=Y
S PRSEDATA(16)=$P(PRSE(0),U,10)
I PRSEDATA(16)]"" S PRSEDATA(16)=$J($FN(PRSEDATA(16),",",2),8)
TYPE ;
S PRSENODE="1^2^3^4^5^6^7^8^9^10"
I $P(PRSE(0),U,16)<8 S PRSENODE=PRSENODE_"^11"
I PRSETYED="C" S PRSENODE=PRSENODE_"^12^13^14^15^16"
S PRSETYPE(0)="C"
F PRSEI=1:1 S PRSE=$P(PRSENODE,U,PRSEI) Q:PRSE'>0!(PRSETYPE(0)="I") D
. I $G(PRSEDATA(PRSE))="" S PRSETYPE(0)="I"
. Q
PRINT ;
I PRSETYPE=PRSETYPE(0) D
. W !
. F PRSEI=1:1 S PRSE=$P(PRSENODE,U,PRSEI) Q:PRSE'>0!PRSEQUIT D
.. I PRSETYPE="C" D WRITE
.. E I $G(PRSEDATA(PRSE))=""!(U_1_U_2_U_7_U_8_U[(U_PRSE_U)) D WRITE
.. I $Y>(IOSL-5),$S(PRSEI<$L(PRSENODE,U):1,$O(^TMP("PRSE",$J,PRSESSN,PRSED0))]"":1,$O(^TMP("PRSE",$J,PRSESSN))]"":1,1:0) D PAUSE,HEADER
.. Q
. Q
Q
WRITE ;
W !,PRSETXT(PRSE),?21,$G(PRSEDATA(PRSE)) S PRSEPRNT=1
Q
PAUSE ;
I $E(IOST)'="C" Q
K DIR S DIR(0)="E" D ^DIR S PRSEQUIT=$S(Y'>0:1,1:0)
Q
I PRSEQUIT Q
I ($E(IOST)="C")!(PRSEPAGE>1) W @IOF
W !?26,"OLDE TRAINING CODING REPORT",?68,PRSENOW
S X=$S(PRSETYPE="C":"COMPLETE",1:"INCOMPLETE")_" DATA FOR "
S X=X_$S(TYP="C":"CALENDAR YEAR",TYP="F":"FISCAL YEAR",1:"DATE RANGE")
S X=X_" "_$S((TYP="C")!(TYP="F"):PYR,1:YRST(1)_" - "_YREND(1))
W !?80-$L(X)/2,X,?68,"PAGE: ",PRSEPAGE,!,PRSEUNDL
S PRSEPAGE=PRSEPAGE+1
Q
DATA ;;
;;SSN
;;Student Name
;;Govt Funded
;;Purpose of Training
;;Source of Training
;;Prg/Cls Category
;;Prg/Cls Title
;;Date Prg/Cls Ended
;;Cls Hrs On Duty
;;Cls Hrs Off Duty
;;Routine/Non-Routine
;;Direct Cost
;;Indirect Cost
;;Student Expense
;;Accrediting Org
;;Contact Hours
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEPOL1 4702 printed Sep 23, 2025@20:03:12 Page 2
PRSEPOL1 ;HISC/DAD,MD-OLDE TRAINING CODING REPORT ;8/26/94 09:34
+1 ;;4.0;PAID;**18**;Sep 21, 1995
ENTSK ;
+1 KILL ^TMP("PRSE",$JOB)
+2 SET PRSEDATE=YRST-.0000001
+3 FOR
SET PRSEDATE=$ORDER(^PRSE(452,"H",PRSEDATE))
if PRSEDATE'>0!(PRSEDATE>YREND)
QUIT
Begin DoDot:1
+4 SET PRSED0=0
+5 FOR
SET PRSED0=$ORDER(^PRSE(452,"H",PRSEDATE,PRSED0))
if PRSED0'>0
QUIT
Begin DoDot:2
+6 SET PRSE=$GET(^PRSE(452,PRSED0,0))
+7 SET PRSE200=+PRSE
SET PRSESSN=$PIECE(PRSE,U,11)
if PRSE200'>0!(PRSESSN="")
QUIT
+8 IF PRSESEL="S"
IF $DATA(PRSEXMY(+$$EN13^PRSEUTL3(PRSE200)))#2
Begin DoDot:3
+9 SET ^TMP("PRSE",$JOB,PRSESSN,PRSED0)=""
+10 QUIT
End DoDot:3
QUIT
+11 IF PRSESEL="A"
IF ($$EN2^PRSEUTL4(+$$EN13^PRSEUTL3(PRSE200))=PSPC("TX")!PSP)
Begin DoDot:3
+12 SET ^TMP("PRSE",$JOB,PRSESSN,PRSED0)=""
+13 QUIT
End DoDot:3
QUIT
+14 QUIT
End DoDot:2
+15 QUIT
End DoDot:1
+16 SET PRSEQUIT=0
SET PRSEPAGE=1
SET PRSEUNDL=""
SET $PIECE(PRSEUNDL,"-",81)=""
+17 SET Y=DT
DO DD^%DT
SET PRSENOW=Y
+18 KILL PRSETXT
+19 FOR PRSE=1:1
SET PRSETXT=$PIECE($TEXT(DATA+PRSE),";",3)
if PRSETXT=""
QUIT
Begin DoDot:1
+20 SET PRSETXT(PRSE)=PRSETXT_":"
+21 QUIT
End DoDot:1
+22 USE IO
DO HEADER
+23 SET (PRSESSN,PRSEPRNT)=0
+24 FOR
SET PRSESSN=$ORDER(^TMP("PRSE",$JOB,PRSESSN))
if PRSESSN'>0!PRSEQUIT
QUIT
Begin DoDot:1
+25 SET PRSED0=0
+26 FOR
SET PRSED0=$ORDER(^TMP("PRSE",$JOB,PRSESSN,PRSED0))
if PRSED0'>0!PRSEQUIT
QUIT
DO GETDATA
+27 QUIT
End DoDot:1
+28 IF PRSEPRNT'>0
WRITE !!,"No data found for this report"
+29 QUIT
GETDATA ;
+1 KILL PRSEDATA
+2 SET PRSE(0)=$GET(^PRSE(452,PRSED0,0))
SET PRSE(2)=$GET(^(2))
SET PRSE(6)=$GET(^(6))
+3 ; *** 'CODE FOR OLDE' not set to 'YES'
IF $PIECE(PRSE(0),U,12)'="Y"
QUIT
+4 ; Type=C/M/O
SET PRSETYED=$PIECE(PRSE(0),U,21)
IF "^C^M^O^"'[(U_PRSETYED_U)
QUIT
+5 SET PRSEDATA(1)=$PIECE(PRSE(0),U,11)
+6 SET PRSEDATA(1)=$EXTRACT("000000000",1,9-$LENGTH(PRSEDATA(1)))_PRSEDATA(1)
+7 SET (Y,PRSEY)=$PIECE(PRSE(0),U)
SET C=$PIECE(^DD(452,.01,0),U,2)
+8 IF Y]""
DO Y^DIQ
IF Y]""
Begin DoDot:1
+9 SET X=$PIECE($GET(^PRSP(454.1,+$$EN3^PRSEUTL3(+PRSEY),0)),U)
+10 SET PRSEDATA(2)=Y_" - "_$SELECT(X]"":X,1:"UNKNOWN")
+11 QUIT
End DoDot:1
+12 SET (PRSEDATA,Y)=$PIECE(PRSE(0),U,22)
SET C=$PIECE(^DD(452,15,0),U,2)
+13 IF Y]""
DO Y^DIQ
IF Y]""
SET PRSEDATA(3)=PRSEDATA_" ("_Y_")"
+14 SET Y=$PIECE(PRSE(2),U)
+15 SET X=$GET(^PRSE(452.51,+Y,0))
SET X(1)=$PIECE(X,U)
SET X(2)=$PIECE(X,U,2)
+16 IF X(1)]""
IF X(2)]""
SET PRSEDATA(4)=X(2)_" ("_X(1)_")"
+17 SET (PRSEDATA,Y)=$PIECE(PRSE(0),U,7)
SET C=$PIECE(^DD(452,6,0),U,2)
+18 IF Y]""
DO Y^DIQ
IF Y]""
SET PRSEDATA(5)=PRSEDATA_" ("_Y_")"
+19 SET Y=$PIECE(PRSE(0),U,5)
+20 SET X=$GET(^PRSE(452.4,+Y,0))
SET X(1)=$PIECE(X,U)
SET X(2)=$PIECE(X,U,2)
+21 IF X(1)]""
IF X(2)]""
SET PRSEDATA(6)=X(2)_" ("_X(1)_")"
+22 SET Y=$PIECE(PRSE(0),U,2)
SET C=$PIECE(^DD(452,1,0),U,2)
+23 IF Y]""
DO Y^DIQ
IF Y]""
SET PRSEDATA(7)=Y_" ("_PRSETYED_")"
+24 SET Y=$PIECE(PRSE(0),U,14)
+25 SET PRSEDATA(8)=$SELECT(Y:$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3),1:"")
+26 SET PRSEDATA(9)=$PIECE(PRSE(0),U,23)
+27 IF PRSEDATA(9)]""
SET PRSEDATA(9)=$JUSTIFY($FNUMBER(PRSEDATA(9),","),5)
+28 SET PRSEDATA(10)=$PIECE(PRSE(0),U,24)
+29 IF PRSEDATA(10)]""
SET PRSEDATA(10)=$JUSTIFY($FNUMBER(PRSEDATA(10),","),5)
+30 SET Y=$PIECE(PRSE(0),U,4)
SET PRSEY=$TRANSLATE(Y,"NR","AB")
SET C=$PIECE(^DD(452,20,0),U,2)
+31 IF Y]""
DO Y^DIQ
IF Y]""
SET PRSEDATA(11)=PRSEY_" ("_Y_")"
+32 SET Y=$PIECE(PRSE(0),U,19)
IF $PIECE(PRSE(6),U)="L"
IF PRSETYED="C"
SET Y=+Y
+33 IF Y]""
SET PRSEDATA(12)=$JUSTIFY($FNUMBER(Y,",",2),8)
+34 SET Y=$PIECE(PRSE(0),U,20)
IF $PIECE(PRSE(6),U)="L"
IF PRSETYED="C"
SET Y=+Y
+35 IF Y]""
SET PRSEDATA(13)=$JUSTIFY($FNUMBER(Y,",",2),8)
+36 SET Y=$PIECE(PRSE(0),U,8)
IF $PIECE(PRSE(6),U)="L"
IF PRSETYED="C"
SET Y=+Y
+37 IF Y]""
SET PRSEDATA(14)=$JUSTIFY($FNUMBER(Y,",",2),8)
+38 SET Y=$PIECE(PRSE(0),U,9)
SET C=$PIECE(^DD(452,8,0),U,2)
+39 IF Y]""
DO Y^DIQ
IF Y]""
SET PRSEDATA(15)=Y
+40 SET PRSEDATA(16)=$PIECE(PRSE(0),U,10)
+41 IF PRSEDATA(16)]""
SET PRSEDATA(16)=$JUSTIFY($FNUMBER(PRSEDATA(16),",",2),8)
TYPE ;
+1 SET PRSENODE="1^2^3^4^5^6^7^8^9^10"
+2 IF $PIECE(PRSE(0),U,16)<8
SET PRSENODE=PRSENODE_"^11"
+3 IF PRSETYED="C"
SET PRSENODE=PRSENODE_"^12^13^14^15^16"
+4 SET PRSETYPE(0)="C"
+5 FOR PRSEI=1:1
SET PRSE=$PIECE(PRSENODE,U,PRSEI)
if PRSE'>0!(PRSETYPE(0)="I")
QUIT
Begin DoDot:1
+6 IF $GET(PRSEDATA(PRSE))=""
SET PRSETYPE(0)="I"
+7 QUIT
End DoDot:1
PRINT ;
+1 IF PRSETYPE=PRSETYPE(0)
Begin DoDot:1
+2 WRITE !
+3 FOR PRSEI=1:1
SET PRSE=$PIECE(PRSENODE,U,PRSEI)
if PRSE'>0!PRSEQUIT
QUIT
Begin DoDot:2
+4 IF PRSETYPE="C"
DO WRITE
+5 IF '$TEST
IF $GET(PRSEDATA(PRSE))=""!(U_1_U_2_U_7_U_8_U[(U_PRSE_U))
DO WRITE
+6 IF $Y>(IOSL-5)
IF $SELECT(PRSEI<$LENGTH(PRSENODE,U):1,$ORDER(^TMP("PRSE",$JOB,PRSESSN,PRSED0))]"":1,$ORDER(^TMP("PRSE",$JOB,PRSESSN))]"":1,1:0)
DO PAUSE
DO HEADER
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
WRITE ;
+1 WRITE !,PRSETXT(PRSE),?21,$GET(PRSEDATA(PRSE))
SET PRSEPRNT=1
+2 QUIT
PAUSE ;
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET PRSEQUIT=$SELECT(Y'>0:1,1:0)
+3 QUIT
+1 IF PRSEQUIT
QUIT
+2 IF ($EXTRACT(IOST)="C")!(PRSEPAGE>1)
WRITE @IOF
+3 WRITE !?26,"OLDE TRAINING CODING REPORT",?68,PRSENOW
+4 SET X=$SELECT(PRSETYPE="C":"COMPLETE",1:"INCOMPLETE")_" DATA FOR "
+5 SET X=X_$SELECT(TYP="C":"CALENDAR YEAR",TYP="F":"FISCAL YEAR",1:"DATE RANGE")
+6 SET X=X_" "_$SELECT((TYP="C")!(TYP="F"):PYR,1:YRST(1)_" - "_YREND(1))
+7 WRITE !?80-$LENGTH(X)/2,X,?68,"PAGE: ",PRSEPAGE,!,PRSEUNDL
+8 SET PRSEPAGE=PRSEPAGE+1
+9 QUIT
DATA ;;
+1 ;;SSN
+2 ;;Student Name
+3 ;;Govt Funded
+4 ;;Purpose of Training
+5 ;;Source of Training
+6 ;;Prg/Cls Category
+7 ;;Prg/Cls Title
+8 ;;Date Prg/Cls Ended
+9 ;;Cls Hrs On Duty
+10 ;;Cls Hrs Off Duty
+11 ;;Routine/Non-Routine
+12 ;;Direct Cost
+13 ;;Indirect Cost
+14 ;;Student Expense
+15 ;;Accrediting Org
+16 ;;Contact Hours
