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