source: FOIAVistA/trunk/r/PAID-PRS/PRSEED12.m@ 1397

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