Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSEED1

PRSEED1.m

Go to the documentation of this file.
  1. PRSEED1 ;HISC-MD/ENTER-EDIT STUDENT RECORD ; MAY 93
  1. ;;4.0;PAID;**18**;Sep 21, 1995
  1. EN1 ; ENTRY FROM OPTION PRSE-I-EMP
  1. S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
  1. K ^TMP($J) S (PRSESW,NOUT,NSW)=0,PRSESRCE="VA",PRSEGF="GOVERNMENT FUNDED",PRSELCL="L",PRSECOD="N" D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q1
  1. TYPE S DIR(0)="SO^M:Mandatory Training (MI);C:Continuing Education;O:Other/Miscellaneous;W:Ward/Unit-Location Training",DIR("A")="Select a Training Type" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(U[X) S POUT=1 G Q1
  1. S PRSESEL=Y
  1. OTHER S NOUT=0 D SCUB G:"^^"[X!($D(POUT)) TYPE
  1. ASK D NAM I $D(POUT) K POUT G OTHER
  1. S (NSW,NDUPSW)=0,PRSENAM=$S($D(^PRSE(452.1,"B",PRSENAM)):"`"_$O(^PRSE(452.1,"B",PRSENAM,0)),1:PRSENAM) D RECHK^PRSEED7 G:NOUT OTHER I 'NDUPSW S DIC("S")="I $P($G(^(0)),U,7)=PRSESEL" K POUT D ADD^PRSEED12 G Q1:$G(POUT)
  1. S PRSENAM=PRSENAM(0)
  1. I '+$O(^PRSE(452.6,"B","MANDATORY TRAINING",0)) S:'$D(^PRSE(452.6,0)) ^(0)="PRSE SVC REASONS FOR TRAINING^452.6^0^0" S X="MANDATORY TRAINING",DIC(0)="L",DIC="^PRSE(452.6,",DLAYGO=452.6 K DD,DO D FILE^DICN
  1. I 'NDUPSW,'NSW W !?9,PRSENAM(0)," ",PRSESTUD," " S Y=PRSEDT D DT^DIQ S NSW=1
  1. G ASK
  1. Q1 W ! D ^PRSEKILL
  1. Q
  1. NAM ;
  1. K POUT,X,Y
  1. I $S($G(DUZ(0))["@":1,+$$EN4^PRSEUTL3($G(DUZ)):1,1:0) I $P($G(^PRSE(452.7,1,0)),U,3) D Q:$G(POUT) G NAM1
  1. . W !
  1. . S Y=$$ADD^XUSERNEW(9)
  1. . I $G(Y)'>0 S POUT=1
  1. ;
  1. I $S($P($G(^PRSE(452.7,1,0)),U,3)'>0:1,'+$$EN4^PRSEUTL3($G(DUZ)):1,$G(DUZ(0))'["@":1,1:0) D I $G(NAMOUT) K NAMOUT G NAM
  1. . R !,"Select Student Name: ",X:DTIME
  1. . I X=""!($E(X)="^") S POUT=1 Q
  1. . S DIC=200,DIC(0)="EQM"
  1. . W ! D ^DIC I +Y'>0 K DIC S NAMOUT=1 D Q
  1. . . W !?5,"Student ",X," could not be found in file. Contact the",!?5,"Education Package Coordinator or IRM to add new entries.",!
  1. . S PRDA(0)=Y
  1. . ;S DIE=DIC,DA=+Y,DR="9R" D ^DIE K DIC,DIE,DR,DA
  1. . S Y=PRDA(0)
  1. ;
  1. NAM1 Q:$G(POUT)
  1. I $G(Y)'>0 G NAM
  1. S PRSESTUD=$P(Y,U,2),VA200DA=+Y
  1. S (PRSESSN,SSN)=$P($G(^VA(200,VA200DA,1)),U,9)
  1. I PRSESSN="" W $C(7),!,"NO SSN FOR THIS STUDENT-CANNOT CONTINUE" G NAM
  1. I $G(SSN)'="" S PRDA=$O(^PRSPC("SSN",SSN,0)) I PRDA>0,$P($G(^PRSPC(+PRDA,0)),U,49)="" D MSG3^PRSEMSG G NAM
  1. S PRSESER=$$EN3^PRSEUTL3($G(VA200DA)) S:PRSESER="" PRSESER("TX")="NON-EMPLOYEE"
  1. S PRDA=+$G(VA200DA)
  1. Q:$D(POUT)
  1. S PRSPDA(1)=$S('+$G(PRSESSN):"",(+$O(^PRSPC("SSN",PRSESSN,0))>0):$O(^PRSPC("SSN",PRSESSN,0)),1:"")
  1. I $S($G(NOUT):1,$G(X)="?":1,1:0) G NAM
  1. I PRSESEL="M",'(+PRSPDA(1)>0) D WRT Q
  1. I $P($G(^PRSPC(+PRSPDA(1),1)),U,33)="Y" D WRT Q ;quit if separation=Y
  1. I '$G(VA200DA) W $C(7),!!,"STUDENT NOT IN NEW PERSON FILE-CANNOT CONTINUE" S POUT=1 Q
  1. Q
  1. SCUB ;
  1. S (PRSENAM,PRSEDT)=""
  1. F K POUT S Y=-1 R !!,"Select TRAINING CLASS: ",X:DTIME S:'$T X="^^" S:X="" Y="" Q:"^^"[X D Q:Y]""
  1. .S DIC("S")="S DATA=$G(^PRSE(452,Y,0)),PRSEIEN=$G(^PRSE(452,""AK"",$P($G(DATA),U,2),Y)) I ($P($G(^PRSE(452,+Y,6)),U)=""L""!($G(^(6))="""")),$P(DATA,U,21)=PRSESEL,(PRSEIEN=$G(PRSESER)!(DUZ(0)[""@""!(+$$EN4^PRSEUTL3($G(DUZ)))))"
  1. .S DIC("W")="W ?($X+4),$P($G(^PRSE(452,+Y,0)),U,13)"
  1. .S DLAYGO=452,DIC=452,DIC(0)=$E("SZE",1,(X'=" ")+2),D="AK" D IX^DIC K DIC I X?1"?".E!(Y>0) W:X=" " " ",$P(Y(0),U,2) S PRSEPREV=Y,Y=$S(Y>0:$P(Y(0),U,2),1:"") Q
  1. .I X=" ",'(+Y>0)!($L(X)<3) S POUT=1 Q
  1. .I '(+Y>0) W !!?3,$C(7),"'"_X_"' IS NOT CURRENTLY IN THE STUDENT TRACKING #452 FILE" S (X,Y)="",POUT=1 Q
  1. Q:Y=""!(Y<0)!($D(POUT)) S PRSENAM=Y K Y
  1. D EN4^PRSEUTL1($G(PRSENAM)) F K POUT S Y=-1 W !!,"Select CLASS DATE: "_$S($G(PRSEY(1))'="":PRSEY(1)_"// ",1:"") R X:DTIME S:'$T X="^^" S:X=""&(+$G(PRSEY)) X=$G(PRSEY) S:X=""&'(+$G(PRSEY)>0) Y="" Q:"^^"[X D Q:Y'=""!(Y<0)
  1. .I X'?1"?".E S %DT="T" D ^%DT S:Y'>0 Y="" Q:Y'>0 D Q
  1. ..S X=Y,Y=$O(^PRSE(452,"AL"_PRSENAM,+X,0)) I Y>0 W " " S Y=X D DT^DIQ Q
  1. ..W !!?3,$C(7),PRSENAM_" IS NOT LISTED FOR THIS DATE " S POUT=1 Q
  1. .W @IOF S (Z,X)=0 F S X=$O(^PRSE(452,"AL"_PRSENAM,X)) Q:X'>0!Z S DA=0 F S DA=$O(^PRSE(452,"AL"_PRSENAM,X,DA)) Q:DA'>0 D Q:Z
  1. ..S Y=$P($G(^PRSE(452,DA,0)),U,3) W !?8 D DT^DIQ
  1. ..I $Y>(IOSL-3) R !?8,"""^"" TO STOP: ",Z:DTIME S:'$T Z="^^" S Z=(Z="^"!(Z="^^")) W @IOF
  1. ..Q
  1. .S %DT="ET" D HELP^%DTC
  1. .S Y=""
  1. .Q
  1. Q:Y=""!(Y<0) S PRSEDT=+X,PRSEDA=$O(^PRSE(452,"AL"_PRSENAM,PRSEDT,0)) Q:'(PRSEDA>0)
  1. Q
  1. ;
  1. WRT W $C(7),!!,"CANNOT PROCESS NON-EMPLOYEE FOR MI CLASSES" S POUT=1 Q