PRSEED12 ;HISC/MD/MH-PRSE NON-LOCAL C.E. ATTENDANCE UPDATE CON'T ;07/11/94
;;4.0;PAID;**18**;Sep 21, 1995
ADD ;NEW ENTRY
S PRSEDATA=$G(^PRSE(452,+$G(PRSEDA),0)),PRSEDATA(2)=$G(^PRSE(452,+$G(PRSEDA),2)),X=PRSENAM,DIC=452.1,DIC(0)="ZM"_$S($E(X)'="`":"E",1:"")
D ^DIC K DIC
S PRSEDA(2)=Y I 'PRSEDA(2)>0,PRSELCL="L" D EN5^PRSEUTL1 Q:$D(POUT)
S PRSEDATA(1)=$G(^PRSE(452.1,+$G(PRSEDA(2)),0)),PRSELNG=$S(PRSELCL="L":$P($G(PRSEDATA(1)),U,3),PRSELCL="N":$P($G(PRSEDATA),U,16),1:"") S:PRSELCL="L" PRSESEL=$S($P($G(PRSEDATA(1)),U,7)]"":$P(PRSEDATA(1),U,7),1:PRSESEL)
S Y=PRSEDT D D^DIQ S PRSEDT(1)=Y,PRSEDA(1)=$G(PRSEDA),PRSENTR="" I '$G(PRSESW)>0,$G(PRSEDA)>0 D
.S:$G(PRSECAT)="" PRSECAT=$P($G(^PRSE(452.4,+$P($G(PRSEDATA),U,5),0)),U)
.I $G(PRSEED)="" S Y=$P($G(PRSEDATA),U,14) D:Y D^DIQ S PRSEED=Y
.S PRSEROU=$P($G(PRSEDATA),U,4),PRSECEU=$P($G(PRSEDATA),U,6),PRSEORG=$P($G(^PRSE(452.9,+$P($G(PRSEDATA),U,9),0)),U),PRSECHR=$P($G(PRSEDATA),U,10)
.S:$G(PRSEPURP)="" PRSEPURP=$P($G(^PRSE(452.51,+$P($G(PRSEDATA(2)),U),0)),U) S:$G(PRSELOC)="" PRSELOC=$P($G(PRSEDATA),U,15) S:$G(PRSECOD)="" PRSECOD=$P($G(PRSEDATA),U,12) S PRSECHON=$P($G(PRSEDATA),U,23),PRSECHOF=$P($G(PRSEDATA),U,24)
.S:'$D(PRSESVC) PRSESVC="" S PRSESW=1
S:$G(^PRSE(452,0))="" ^(0)="PRSE STUDENT TRACKING FILE^452P^^"
S X=VA200DA,DIC(0)="Q",DIC="^PRSE(452,",DLAYGO=452 K DD,DO D FILE^DICN S (PRSEDA,DA)=+Y S:$G(^PRSE(452,+Y,1,0))="" ^(0)="^452.033PA^^"
I $G(PRSEQWIK) S PRSESVC=$O(^PRSE(452.6,"B","MANDATORY TRAINING",0)) I PRSESVC'="" S ^PRSE(452,DA,1,1,0)=PRSESVC,^PRSE(452,DA,1,"B",PRSESVC,1)=""
I $G(PRSEDA(1)),'$G(PRSEQWIK) F D1=0:0 S D1=$O(^PRSE(452,PRSEDA(1),1,D1)) Q:D1'>0 S %X="^PRSE(452,+PRSEDA(1),1,D1,",%Y="^PRSE(452,+DA,1,D1," D %XY^%RCR
S DIK="^PRSE(452,DA(1),1,",DIK(1)=".01^B",DA(1)=DA D ENALL^DIK
I (+PRSEDA>0) D
.S DA=PRSEDA,DIE=452 I $G(PRSEED)="" S PRSEED=PRSEDT(1)
.S DR="5///"_PRSESEL_";1///"_PRSENAM(0)_";2////"_PRSEDT_"" D ^DIE K DR
.I '(PRSESEL="M") D
..I $G(PRSENAM(0))]"" W !,"CLASS NAME: ",PRSENAM(0)
..S PRSECOD=$S($G(PRSECOD)="N":"NOT CODED",$G(PRSECOD)="Y":"CODED",1:""),PRSEROU=$S($G(PRSEROU)="R":"ROUTINE",$G(PRSEROU)="N":"NON-ROUTINE",1:""),PRSEGF=$S($G(PRSEGF)="G":"GOVERNMENT FUNDED",$G(PRSEGF)="E":"EMPLOYEE FUNDED",1:"")
..S DR="13//"_PRSEED_";"_$S('$G(PRSESW):"6//"_PRSESRCE_";",1:"6//"_PRSESRCE_";")_"10////"_PRSESSN_";12////"_PRSESER("TX")_";14////"_PRSELCL_""
..S DR(1,452,1)=$S($G(PRSECAT)="":"4T;",1:"4T//"_PRSECAT_";")_$S($G(PRSEPURP)="":"4.1;",1:"4.1//"_PRSEPURP_";")_$S($G(PRSELNG)="":"2.1",1:"2.1//"_PRSELNG_"")
..S DR(1,452,2)="S:'$G(PRSELNG) PRSELNG=+$P($G(^PRSE(452,DA,0)),U,16);2.2//^S X=$FN(PRSELNG,"""",0);"_$S($G(PRSECHOF)="":"2.3;",1:"2.3//"_PRSECHOF_";")_"D SUPPR^PRSEED12;S:PRSENTR="""" Y=""@1"";"_"2.4///^S X=PRSENTR"
..S DR(1,452,3)="D LOC^PRSEED3;13.5///^S X=PRSELOC;@1;"_$S($G(PRSECOD)="":"11;",1:"11//"_PRSECOD_";")_$S('$G(PRSESW):"15//"_PRSEGF_";",1:"15//"_PRSEGF_";")_$S($G(PRSEROU)="":"20;",1:"20//"_PRSEROU_";")
..S DR(1,452,4)=$S($G(PRSEORG)="":"8;",1:"8//"_PRSEORG_";")_$S($G(PRSECHR)="":"9;",1:"9//"_PRSECHR_";")_$S($G(PRSECEU)="":"9.1;",1:"9.1//"_PRSECEU_";")_"33"
.I PRSESEL="M" D
..I $G(PRSENAM(0))]"",$G(PRSECAT)="" W !,"CLASS NAME: ",PRSENAM(0)
..S X=PRSEDT D ^%DT S (PRSEDT(1),PRSEED)=Y,DR="13////"_PRSEED_";"_$S('$G(PRSESW):"6//"_PRSESRCE_";",1:"6///"_PRSESRCE_";")_"10////"_PRSESSN_";12////"_PRSESER("TX")_";14////"_PRSELCL_""
..S DR(1,452,1)=$S($G(PRSECAT)="":"4T;",1:"4///"_PRSECAT_";")_$S($G(PRSEPURP)="":"4.1;",1:"4.1///"_PRSEPURP_";")_$S($G(PRSELNG)="":"2.1",1:"2.1///"_PRSELNG_"")
..S DR(1,452,2)=$S($G(PRSECOD)="":"11;",1:"11///"_PRSECOD_";")_$S($G(PRSELOC)="":"13.5;",1:"13.5////"_PRSELOC_";")_$S('$G(PRSESW):"15//"_PRSEGF_";",1:"15///"_PRSEGF_";")_$S($G(PRSEROU)="":"20;",1:"20///"_PRSEROU_";")
.D ^DIE K DR
.I $D(Y)'=0 D DEL(PRSEDA) K PRSEDA S POUT=1 Q
.S PRSECAT=$P($G(^PRSE(452,+PRSEDA,0)),U,5),PRSECAT=$P($G(^PRSE(452.4,+PRSECAT,0)),U) Q:$D(Y) I PRSESEL="C" D AAINFO^PRSEED7
.K DIE,DR S PRSEDA=$O(^PRSE(452,"AK",PRSENAM(0),0))
Q
LOOP F PRSEI=0:0 S PRSEI=$O(NCLAS(PRSEI)) Q:PRSEI>(NCTR-1) I $D(NCLASS(PRSEI)),$O(NCLASS(PRSEI,0)) S ^TMP($J,$O(NCLASS(PRSEI,0)))=""
Q
SUPPR ;
N Y,PRSESAVX S PRSENTR=$P($G(^PRSE(452,+PRSEDA(1),6)),U,2) W !,"PRESENTER/SUPPLIER: "_$S($G(PRSENTR)'="":PRSENTR_"// ",1:"") R X:DTIME I '$T!(X=U) S POUT=1 Q
I X="",$G(PRSENTR)'="" S X=PRSENTR Q
I X="@" S PRSENTR=X Q
S PRSESAVX=X,DIC=200,DIC(0)="EFMZ" D ^DIC K DIC I $D(DTOUT) S POUT=1 Q
K % I Y>0 D Q:Y
.F D Q:%
..W !!?5,"Is this the one you want" S %=2 D YN^DICN I '% W !!?10,"Answer Y(es) or N(o)"
.I %=1 S PRSENTR=Y(0,0) Q
.S Y=0 Q
S X=PRSESAVX I X'="",X'["?",$G(%)'="" W !!,X
S:$P($G(^PRSE(452.7,1,0)),U,4) DLAYGO=452.2 S DIC=452.2,DIC(0)="QEMZ"_$S($P($G(^PRSE(452.7,1,0)),U,4):"L",1:"") D ^DIC D:Y'>0&(PRSESAVX]"")&(DIC(0)'["L") MSG5^PRSEMSG K DIC I $D(DTOUT) S POUT=1 Q
I $P(Y,U,3) S PRSENTR=Y(0,0) Q
I Y>0 D Q:Y
.F D Q:%
..W !!?5,"Is this the one you want" S %=2 D YN^DICN I '% W !!?10,"Answer Y(es) or N(o)"
.I %=1 S PRSENTR=Y(0,0) Q
.S Y=0 Q
G:X["?" SUPPR I Y'>0,PRSESAVX]"" G SUPPR
Q
;
DEL(DA) ;call to delete entry from file 452 if user enters '^'
;DA= ien of file 452
;
Q:'$G(DA)
S DIK="^PRSE(452," D ^DIK K DIK
W !?3,"Entry Deleted.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEED12 5311 printed Dec 13, 2024@02:26:24 Page 2
PRSEED12 ;HISC/MD/MH-PRSE NON-LOCAL C.E. ATTENDANCE UPDATE CON'T ;07/11/94
+1 ;;4.0;PAID;**18**;Sep 21, 1995
ADD ;NEW ENTRY
+1 SET PRSEDATA=$GET(^PRSE(452,+$GET(PRSEDA),0))
SET PRSEDATA(2)=$GET(^PRSE(452,+$GET(PRSEDA),2))
SET X=PRSENAM
SET DIC=452.1
SET DIC(0)="ZM"_$SELECT($EXTRACT(X)'="`":"E",1:"")
+2 DO ^DIC
KILL DIC
+3 SET PRSEDA(2)=Y
IF 'PRSEDA(2)>0
IF PRSELCL="L"
DO EN5^PRSEUTL1
if $DATA(POUT)
QUIT
+4 SET PRSEDATA(1)=$GET(^PRSE(452.1,+$GET(PRSEDA(2)),0))
SET PRSELNG=$SELECT(PRSELCL="L":$PIECE($GET(PRSEDATA(1)),U,3),PRSELCL="N":$PIECE($GET(PRSEDATA),U,16),1:"")
if PRSELCL="L"
SET PRSESEL=$SELECT($PIECE($GET(PRSEDATA(1)),U,7)]"":$PIECE(PRSEDATA(1),U,7),1:PRSESEL)
+5 SET Y=PRSEDT
DO D^DIQ
SET PRSEDT(1)=Y
SET PRSEDA(1)=$GET(PRSEDA)
SET PRSENTR=""
IF '$GET(PRSESW)>0
IF $GET(PRSEDA)>0
Begin DoDot:1
+6 if $GET(PRSECAT)=""
SET PRSECAT=$PIECE($GET(^PRSE(452.4,+$PIECE($GET(PRSEDATA),U,5),0)),U)
+7 IF $GET(PRSEED)=""
SET Y=$PIECE($GET(PRSEDATA),U,14)
if Y
DO D^DIQ
SET PRSEED=Y
+8 SET PRSEROU=$PIECE($GET(PRSEDATA),U,4)
SET PRSECEU=$PIECE($GET(PRSEDATA),U,6)
SET PRSEORG=$PIECE($GET(^PRSE(452.9,+$PIECE($GET(PRSEDATA),U,9),0)),U)
SET PRSECHR=$PIECE($GET(PRSEDATA),U,10)
+9 if $GET(PRSEPURP)=""
SET PRSEPURP=$PIECE($GET(^PRSE(452.51,+$PIECE($GET(PRSEDATA(2)),U),0)),U)
if $GET(PRSELOC)=""
SET PRSELOC=$PIECE($GET(PRSEDATA),U,15)
if $GET(PRSECOD)=""
SET PRSECOD=$PIECE($GET(PRSEDATA),U,12)
SET PRSECHON=$PIECE($GET(PRSEDATA),U,23)
SET PRSECHOF=$PIECE($GET(PRSEDATA),U,24)
+10 if '$DATA(PRSESVC)
SET PRSESVC=""
SET PRSESW=1
End DoDot:1
+11 if $GET(^PRSE(452,0))=""
SET ^(0)="PRSE STUDENT TRACKING FILE^452P^^"
+12 SET X=VA200DA
SET DIC(0)="Q"
SET DIC="^PRSE(452,"
SET DLAYGO=452
KILL DD,DO
DO FILE^DICN
SET (PRSEDA,DA)=+Y
if $GET(^PRSE(452,+Y,1,0))=""
SET ^(0)="^452.033PA^^"
+13 IF $GET(PRSEQWIK)
SET PRSESVC=$ORDER(^PRSE(452.6,"B","MANDATORY TRAINING",0))
IF PRSESVC'=""
SET ^PRSE(452,DA,1,1,0)=PRSESVC
SET ^PRSE(452,DA,1,"B",PRSESVC,1)=""
+14 IF $GET(PRSEDA(1))
IF '$GET(PRSEQWIK)
FOR D1=0:0
SET D1=$ORDER(^PRSE(452,PRSEDA(1),1,D1))
if D1'>0
QUIT
SET %X="^PRSE(452,+PRSEDA(1),1,D1,"
SET %Y="^PRSE(452,+DA,1,D1,"
DO %XY^%RCR
+15 SET DIK="^PRSE(452,DA(1),1,"
SET DIK(1)=".01^B"
SET DA(1)=DA
DO ENALL^DIK
+16 IF (+PRSEDA>0)
Begin DoDot:1
+17 SET DA=PRSEDA
SET DIE=452
IF $GET(PRSEED)=""
SET PRSEED=PRSEDT(1)
+18 SET DR="5///"_PRSESEL_";1///"_PRSENAM(0)_";2////"_PRSEDT_""
DO ^DIE
KILL DR
+19 IF '(PRSESEL="M")
Begin DoDot:2
+20 IF $GET(PRSENAM(0))]""
WRITE !,"CLASS NAME: ",PRSENAM(0)
+21 SET PRSECOD=$SELECT($GET(PRSECOD)="N":"NOT CODED",$GET(PRSECOD)="Y":"CODED",1:"")
SET PRSEROU=$SELECT($GET(PRSEROU)="R":"ROUTINE",$GET(PRSEROU)="N":"NON-ROUTINE",1:"")
SET PRSEGF=$SELECT($GET(PRSEGF)="G":"GOVERNMENT FUNDED",$GET(PRSEGF)="E":"EMPLOYEE FUNDED",1:"")
+22 SET DR="13//"_PRSEED_";"_$SELECT('$GET(PRSESW):"6//"_PRSESRCE_";",1:"6//"_PRSESRCE_";")_"10////"_PRSESSN_";12////"_PRSESER("TX")_";14////"_PRSELCL_""
+23 SET DR(1,452,1)=$SELECT($GET(PRSECAT)="":"4T;",1:"4T//"_PRSECAT_";")_$SELECT($GET(PRSEPURP)="":"4.1;",1:"4.1//"_PRSEPURP_";")_$SELECT($GET(PRSELNG)="":"2.1",1:"2.1//"_PRSELNG_"")
+24 SET DR(1,452,2)="S:'$G(PRSELNG) PRSELNG=+$P($G(^PRSE(452,DA,0)),U,16);2.2//^S X=$FN(PRSELNG,"""",0);"_$SELECT($GET(PRSECHOF)="":"2.3;",1:"2.3//"_PRSECHOF_";")_"D SUPPR^PRSEED12;S:PRSENTR="""" Y=""@1"";"_"2.4///^S X=PRSENTR"
+25 SET DR(1,452,3)="D LOC^PRSEED3;13.5///^S X=PRSELOC;@1;"_$SELECT($GET(PRSECOD)="":"11;",1:"11//"_PRSECOD_";")_$SELECT('$GET(PRSESW):"15//"_PRSEGF_";",1:"15//"_PRSEGF_";")_$SELECT($GET(PRSEROU)="":"20;",1:"20//"_PRSEROU_";")
+26 SET DR(1,452,4)=$SELECT($GET(PRSEORG)="":"8;",1:"8//"_PRSEORG_";")_$SELECT($GET(PRSECHR)="":"9;",1:"9//"_PRSECHR_";")_$SELECT($GET(PRSECEU)="":"9.1;",1:"9.1//"_PRSECEU_";")_"33"
End DoDot:2
+27 IF PRSESEL="M"
Begin DoDot:2
+28 IF $GET(PRSENAM(0))]""
IF $GET(PRSECAT)=""
WRITE !,"CLASS NAME: ",PRSENAM(0)
+29 SET X=PRSEDT
DO ^%DT
SET (PRSEDT(1),PRSEED)=Y
SET DR="13////"_PRSEED_";"_$SELECT('$GET(PRSESW):"6//"_PRSESRCE_";",1:"6///"_PRSESRCE_";")_"10////"_PRSESSN_";12////"_PRSESER("TX")_";14////"_PRSELCL_""
+30 SET DR(1,452,1)=$SELECT($GET(PRSECAT)="":"4T;",1:"4///"_PRSECAT_";")_$SELECT($GET(PRSEPURP)="":"4.1;",1:"4.1///"_PRSEPURP_";")_$SELECT($GET(PRSELNG)="":"2.1",1:"2.1///"_PRSELNG_"")
+31 SET DR(1,452,2)=$SELECT($GET(PRSECOD)="":"11;",1:"11///"_PRSECOD_";")_$SELECT($GET(PRSELOC)="":"13.5;",1:"13.5////"_PRSELOC_";")_$SELECT('$GET(PRSESW):"15//"_PRSEGF_";",1:"15///"_PRSEGF_";")_$SELECT($GET(PRSEROU)="":"20;",1:"20/
//"_PRSEROU_";")
End DoDot:2
+32 DO ^DIE
KILL DR
+33 IF $DATA(Y)'=0
DO DEL(PRSEDA)
KILL PRSEDA
SET POUT=1
QUIT
+34 SET PRSECAT=$PIECE($GET(^PRSE(452,+PRSEDA,0)),U,5)
SET PRSECAT=$PIECE($GET(^PRSE(452.4,+PRSECAT,0)),U)
if $DATA(Y)
QUIT
IF PRSESEL="C"
DO AAINFO^PRSEED7
+35 KILL DIE,DR
SET PRSEDA=$ORDER(^PRSE(452,"AK",PRSENAM(0),0))
End DoDot:1
+36 QUIT
LOOP FOR PRSEI=0:0
SET PRSEI=$ORDER(NCLAS(PRSEI))
if PRSEI>(NCTR-1)
QUIT
IF $DATA(NCLASS(PRSEI))
IF $ORDER(NCLASS(PRSEI,0))
SET ^TMP($JOB,$ORDER(NCLASS(PRSEI,0)))=""
+1 QUIT
SUPPR ;
+1 NEW Y,PRSESAVX
SET PRSENTR=$PIECE($GET(^PRSE(452,+PRSEDA(1),6)),U,2)
WRITE !,"PRESENTER/SUPPLIER: "_$SELECT($GET(PRSENTR)'="":PRSENTR_"// ",1:"")
READ X:DTIME
IF '$TEST!(X=U)
SET POUT=1
QUIT
+2 IF X=""
IF $GET(PRSENTR)'=""
SET X=PRSENTR
QUIT
+3 IF X="@"
SET PRSENTR=X
QUIT
+4 SET PRSESAVX=X
SET DIC=200
SET DIC(0)="EFMZ"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)
SET POUT=1
QUIT
+5 KILL %
IF Y>0
Begin DoDot:1
+6 FOR
Begin DoDot:2
+7 WRITE !!?5,"Is this the one you want"
SET %=2
DO YN^DICN
IF '%
WRITE !!?10,"Answer Y(es) or N(o)"
End DoDot:2
if %
QUIT
+8 IF %=1
SET PRSENTR=Y(0,0)
QUIT
+9 SET Y=0
QUIT
End DoDot:1
if Y
QUIT
+10 SET X=PRSESAVX
IF X'=""
IF X'["?"
IF $GET(%)'=""
WRITE !!,X
+11 if $PIECE($GET(^PRSE(452.7,1,0)),U,4)
SET DLAYGO=452.2
SET DIC=452.2
SET DIC(0)="QEMZ"_$SELECT($PIECE($GET(^PRSE(452.7,1,0)),U,4):"L",1:"")
DO ^DIC
if Y'>0&(PRSESAVX]"")&(DIC(0)'["L")
DO MSG5^PRSEMSG
KILL DIC
IF $DATA(DTOUT)
SET POUT=1
QUIT
+12 IF $PIECE(Y,U,3)
SET PRSENTR=Y(0,0)
QUIT
+13 IF Y>0
Begin DoDot:1
+14 FOR
Begin DoDot:2
+15 WRITE !!?5,"Is this the one you want"
SET %=2
DO YN^DICN
IF '%
WRITE !!?10,"Answer Y(es) or N(o)"
End DoDot:2
if %
QUIT
+16 IF %=1
SET PRSENTR=Y(0,0)
QUIT
+17 SET Y=0
QUIT
End DoDot:1
if Y
QUIT
+18 if X["?"
GOTO SUPPR
IF Y'>0
IF PRSESAVX]""
GOTO SUPPR
+19 QUIT
+20 ;
DEL(DA) ;call to delete entry from file 452 if user enters '^'
+1 ;DA= ien of file 452
+2 ;
+3 if '$GET(DA)
QUIT
+4 SET DIK="^PRSE(452,"
DO ^DIK
KILL DIK
+5 WRITE !?3,"Entry Deleted.",!
+6 QUIT
