- 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 Jan 18, 2025@03:27:33 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