PRSEED6 ;HISC/MD-ENTER/EDIT-CLASS REGISTRATION ;12/14/1999
;;4.0;PAID;**5,18,44,53**;Sep 21, 1995
EN1 ; ENTRY FROM PRSE-CLS-REG
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
K ^TMP("PRSE",$J) S (NOUT,NSW)=0 D EN2^PRSEUTL3($G(DUZ)) I PRSESER="",'(DUZ(0)="@") D MSG3^PRSEMSG G QQ
SEL S DIR(0)="SO^R:Class Registration Calendar Report;S:Student Registration",DIR("A")="Choose a Selection from the above choices" D ^DIR K DIR G:$D(DTOUT)!($D(DUOUT))!(U[X)!(Y="") QQ
I Y="R" S:$G(PRSESLF) SSLF=1 W ! D EN1^PRSECAL,QQ G EN1^PRSEED5:$G(SSLF),EN1
E S REGSW=1 D INS^PRSEUTL G:$D(DTOUT)!($D(DUOUT))!(U[X)!(Y="") QQ
CLAS ; SELECT CLASS IN 452.8 FILE
W ! S PRSETYP=PRSESEL,PRSE=0,DIC=452.1,DIC(0)="AEQMZ",DIC("A")="CLASS NAME: ",DIC("S")="I +$$DICS^PRSEUTL(.PRSE)"
S DIC("W")="W ?($X+5),$P($G(^PRSP(454.1,+$P(^(0),U,8),0)),U)"
D ^DIC K DIC G:X="" EN1 I $D(DTOUT)!($D(DUOUT))!(X=U)!'(Y>0) S POUT=1 G QQ
;
S PRSEPROG=Y(0,0),PRSEPROG(1)=Y(0),PRSEMI=+Y,X=$P(Y,U,2),DIC="^PRSE(452.8,",DIC(0)="",DIC("S")="I $P(^(0),U)=PRSEMI" D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S POUT=1 G QQ
;
W ! D NOW^%DTC S PRSEDT("NOW")=%,PRSEY=^PRSE(452.8,+Y,0),PRSETYP=$P(^PRSE(452.8,+Y,0),U,5),(PRX,DA(2),PRSEDA)=+Y,Y=$$EN4^PRSEUTL2($G(PRX))
S Z=$O(^PRSE(452.8,+PRX,3,"C",0)) I '((9999999-Z)<PRSEDT("NOW")) S DIC("B")=PRSEDT
I PRSEDT=0 D MSG20^PRSEMSG G CLAS
D NOW^%DTC S PRSEDT("NOW")=%
S DA(1)=PRSEDA,DIC(0)="AEMQZ",DIC="^PRSE(452.8,DA(1),3,",DIC("A")="Select DATE: ",DIC("S")="N Z S Z=+$G(^(0)) S:'$P(Z,""."",2) $P(Z,""."",2)=$P(PRSEDT(""NOW""),""."",2) I '(+Z<PRSEDT(""NOW""))"
S DIC("W")="W:$P(^(0),U,5)=0 ?($X+1),""* REGISTRATION UNAVAILABLE *"""
D ^DIC K DIC I $D(DTOUT)!($D(DUOUT))!(U[X) S POUT=1 G QQ
I $D(^PRSE(452.8,DA(2),3,+Y,0)),$P(^(0),U,5)=0 D MSG4^PRSEMSG G CLAS
;
S PRSEGLO=$P($G(^PRSE(452.8,0)),U)
S PRSEDA(2)=PRSEDA,PRSEDA(1)=+Y I '$D(^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),1,0)) S ^(0)="^452.8894P^^"
S PRSEDAT=$P($G(^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0)),U)
L +^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0):0 I '$T D MSG^PRSEMSG G CLAS
; register/unregister students
K POUT F D STUD Q:X="^"!$G(POUT)
L -^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0)
G QQ:$G(POUT)
G CLAS
;
STUD ; STUDENT REGISTRATION
N VA200 ; ien to file 200 ^ name
S DA(2)=PRSEDA,DA(1)=PRSEDA(1)
D EN2^PRSEUTL3($G(DUZ)) ; determine user service
S DATA=$P($G(^PRSE(452.8,DA(2),3,DA(1),0)),U,5)
S DATA(1)=$P($G(^PRSE(452.8,DA(2),3,DA(1),1,0)),U,4)
;
I $D(PRSESLF) D S X="^" Q
. S PRS("SAV")=+$G(PRSESER)
. S:$G(PRSESER) PRSESER=$P($G(^PRSP(454.1,+PRSESER,0)),U)
. S PRSEEMP=+DUZ
. D ADD
. S PRSESER=+$G(PRS("SAV"))
. S REGSW=1
;
W !!,"Enter STUDENT NAME: " R X:DTIME I (U[X)!(X[U) S X="^" Q
S PRSESAVX=X
; if ? then list registered students
I PRSESAVX["?" S D="B",DIC="^PRSE(452.8,DA(2),3,DA(1),1,",DIC(0)="EMZ" D DQ^DICQ K DIC S X=PRSESAVX
; perform lookup with X in NEW PERSON file
S DIC=200,DIC(0)="EMZ"
S DIC("W")="W ?($X+3),$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3(+$G(Y)),0)),U)"
D ^DIC K DIC Q:X=U
Q:PRSESAVX["?" ; ? was entered so there is no student to process
S VA200=Y
;
; if lookup failed
I +VA200'>0 D I +VA200'>0 Q
. W !,"A NEW PERSON record has not been identified for student ",X,!
. ; if laygo allowed then support addition to NEW PERSON
. I $P($G(^PRSE(452.7,1,0)),U,3)>0,($G(DUZ(0))["@")!(+$$EN4^PRSEUTL3($G(DUZ))) D Q
. . S DIR(0)="Y",DIR("B")="YES"
. . S DIR("A")="Do you want to add a non VA employee to the NEW PERSON (#200) file"
. . D ^DIR K DIR S:$D(DTOUT)!$D(DUOUT) POUT=1 Q:$D(DIRUT)!'Y
. . S VA200=$$ADD^XUSERNEW("9R")
. ; laygo not allowed
. D MSG15^PRSEMSG
;
S PRSESER=$$EN3^PRSEUTL3(+VA200)
S PRSESSN=$$GET1^DIQ(200,+VA200,9)
I PRSESSN="" W !,$C(7),"NO SSN IN NEW PERSON FILE-CANNOT CONTINUE" W ! Q
S DA=$P(^PRSE(452.8,DA(2),3,DA(1),1,0),U,3)+1
S (PRDA,PRSEEMP)=+VA200
S PRSENAM=$P(VA200,U,2)
S PRSESER=$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3($G(PRDA)),0)),U)
D ADD
Q
;
ADD ; PREVIOUS ATTENDANCE CHK
I +DATA>0,DATA(1)'<DATA,'$D(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP)) D MSG17^PRSEMSG Q
N X S DA=($P(^PRSE(452.8,DA(2),3,DA(1),1,0),U,3)+1) I $D(^PRSE(452,"AA",PRSETYP,PRSEEMP,PRSEPROG,(9999999-PRSEDAT))) S Y=PRSEDAT D DD^%DT S PRSEDAT=Y,PRSECLS=PRSEPROG D MSG18^PRSEMSG Q
I '$D(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP)) D
ADD1 .S:PRSESER="" PRSESER="NON-EMPLOYEE" W !!,"Do you want to register "_PRSENAM_" - "_PRSESER_" for",!,PRSEPROG S %=1 D YN^DICN I %=0 W $C(7),!!,"Answer YES or NO." G ADD1
.I '(%=1)&'(%=2) S POUT=1 Q
.Q
I '$G(POUT),$D(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP)) S DA=$O(^(+PRSEEMP,0)) D MSG7^PRSEMSG,DEL^PRSEED3
Q:$G(%)=2 I $G(%)=1 K DD,DO S DIC="^PRSE(452.8,DA(2),3,DA(1),1,",DIC("DR")="1////"_PRSESER_";3////"_PRSESSN_";4////^S X=""E""",DIC(0)="L",X=+PRSEEMP,DLAYGO=452.8894 D FILE^DICN
Q
QQ D ^PRSEKILL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSEED6 4875 printed Apr 09, 2024@21:29:41 Page 2
PRSEED6 ;HISC/MD-ENTER/EDIT-CLASS REGISTRATION ;12/14/1999
+1 ;;4.0;PAID;**5,18,44,53**;Sep 21, 1995
EN1 ; ENTRY FROM PRSE-CLS-REG
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 KILL ^TMP("PRSE",$JOB)
SET (NOUT,NSW)=0
DO EN2^PRSEUTL3($GET(DUZ))
IF PRSESER=""
IF '(DUZ(0)="@")
DO MSG3^PRSEMSG
GOTO QQ
SEL SET DIR(0)="SO^R:Class Registration Calendar Report;S:Student Registration"
SET DIR("A")="Choose a Selection from the above choices"
DO ^DIR
KILL DIR
if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)!(Y="")
GOTO QQ
+1 IF Y="R"
if $GET(PRSESLF)
SET SSLF=1
WRITE !
DO EN1^PRSECAL
DO QQ
if $GET(SSLF)
GOTO EN1^PRSEED5
GOTO EN1
+2 IF '$TEST
SET REGSW=1
DO INS^PRSEUTL
if $DATA(DTOUT)!($DATA(DUOUT))!(U[X)!(Y="")
GOTO QQ
CLAS ; SELECT CLASS IN 452.8 FILE
+1 WRITE !
SET PRSETYP=PRSESEL
SET PRSE=0
SET DIC=452.1
SET DIC(0)="AEQMZ"
SET DIC("A")="CLASS NAME: "
SET DIC("S")="I +$$DICS^PRSEUTL(.PRSE)"
+2 SET DIC("W")="W ?($X+5),$P($G(^PRSP(454.1,+$P(^(0),U,8),0)),U)"
+3 DO ^DIC
KILL DIC
if X=""
GOTO EN1
IF $DATA(DTOUT)!($DATA(DUOUT))!(X=U)!'(Y>0)
SET POUT=1
GOTO QQ
+4 ;
+5 SET PRSEPROG=Y(0,0)
SET PRSEPROG(1)=Y(0)
SET PRSEMI=+Y
SET X=$PIECE(Y,U,2)
SET DIC="^PRSE(452.8,"
SET DIC(0)=""
SET DIC("S")="I $P(^(0),U)=PRSEMI"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET POUT=1
GOTO QQ
+6 ;
+7 WRITE !
DO NOW^%DTC
SET PRSEDT("NOW")=%
SET PRSEY=^PRSE(452.8,+Y,0)
SET PRSETYP=$PIECE(^PRSE(452.8,+Y,0),U,5)
SET (PRX,DA(2),PRSEDA)=+Y
SET Y=$$EN4^PRSEUTL2($GET(PRX))
+8 SET Z=$ORDER(^PRSE(452.8,+PRX,3,"C",0))
IF '((9999999-Z)<PRSEDT("NOW"))
SET DIC("B")=PRSEDT
+9 IF PRSEDT=0
DO MSG20^PRSEMSG
GOTO CLAS
+10 DO NOW^%DTC
SET PRSEDT("NOW")=%
+11 SET DA(1)=PRSEDA
SET DIC(0)="AEMQZ"
SET DIC="^PRSE(452.8,DA(1),3,"
SET DIC("A")="Select DATE: "
SET DIC("S")="N Z S Z=+$G(^(0)) S:'$P(Z,""."",2) $P(Z,""."",2)=$P(PRSEDT(""NOW""),""."",2) I '(+Z<PRSEDT(""NOW""))"
+12 SET DIC("W")="W:$P(^(0),U,5)=0 ?($X+1),""* REGISTRATION UNAVAILABLE *"""
+13 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))!(U[X)
SET POUT=1
GOTO QQ
+14 IF $DATA(^PRSE(452.8,DA(2),3,+Y,0))
IF $PIECE(^(0),U,5)=0
DO MSG4^PRSEMSG
GOTO CLAS
+15 ;
+16 SET PRSEGLO=$PIECE($GET(^PRSE(452.8,0)),U)
+17 SET PRSEDA(2)=PRSEDA
SET PRSEDA(1)=+Y
IF '$DATA(^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),1,0))
SET ^(0)="^452.8894P^^"
+18 SET PRSEDAT=$PIECE($GET(^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0)),U)
+19 LOCK +^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0):0
IF '$TEST
DO MSG^PRSEMSG
GOTO CLAS
+20 ; register/unregister students
+21 KILL POUT
FOR
DO STUD
if X="^"!$GET(POUT)
QUIT
+22 LOCK -^PRSE(452.8,PRSEDA(2),3,PRSEDA(1),0)
+23 if $GET(POUT)
GOTO QQ
+24 GOTO CLAS
+25 ;
STUD ; STUDENT REGISTRATION
+1 ; ien to file 200 ^ name
NEW VA200
+2 SET DA(2)=PRSEDA
SET DA(1)=PRSEDA(1)
+3 ; determine user service
DO EN2^PRSEUTL3($GET(DUZ))
+4 SET DATA=$PIECE($GET(^PRSE(452.8,DA(2),3,DA(1),0)),U,5)
+5 SET DATA(1)=$PIECE($GET(^PRSE(452.8,DA(2),3,DA(1),1,0)),U,4)
+6 ;
+7 IF $DATA(PRSESLF)
Begin DoDot:1
+8 SET PRS("SAV")=+$GET(PRSESER)
+9 if $GET(PRSESER)
SET PRSESER=$PIECE($GET(^PRSP(454.1,+PRSESER,0)),U)
+10 SET PRSEEMP=+DUZ
+11 DO ADD
+12 SET PRSESER=+$GET(PRS("SAV"))
+13 SET REGSW=1
End DoDot:1
SET X="^"
QUIT
+14 ;
+15 WRITE !!,"Enter STUDENT NAME: "
READ X:DTIME
IF (U[X)!(X[U)
SET X="^"
QUIT
+16 SET PRSESAVX=X
+17 ; if ? then list registered students
+18 IF PRSESAVX["?"
SET D="B"
SET DIC="^PRSE(452.8,DA(2),3,DA(1),1,"
SET DIC(0)="EMZ"
DO DQ^DICQ
KILL DIC
SET X=PRSESAVX
+19 ; perform lookup with X in NEW PERSON file
+20 SET DIC=200
SET DIC(0)="EMZ"
+21 SET DIC("W")="W ?($X+3),$P($G(^PRSP(454.1,+$$EN3^PRSEUTL3(+$G(Y)),0)),U)"
+22 DO ^DIC
KILL DIC
if X=U
QUIT
+23 ; ? was entered so there is no student to process
if PRSESAVX["?"
QUIT
+24 SET VA200=Y
+25 ;
+26 ; if lookup failed
+27 IF +VA200'>0
Begin DoDot:1
+28 WRITE !,"A NEW PERSON record has not been identified for student ",X,!
+29 ; if laygo allowed then support addition to NEW PERSON
+30 IF $PIECE($GET(^PRSE(452.7,1,0)),U,3)>0
IF ($GET(DUZ(0))["@")!(+$$EN4^PRSEUTL3($GET(DUZ)))
Begin DoDot:2
+31 SET DIR(0)="Y"
SET DIR("B")="YES"
+32 SET DIR("A")="Do you want to add a non VA employee to the NEW PERSON (#200) file"
+33 DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)
SET POUT=1
if $DATA(DIRUT)!'Y
QUIT
+34 SET VA200=$$ADD^XUSERNEW("9R")
End DoDot:2
QUIT
+35 ; laygo not allowed
+36 DO MSG15^PRSEMSG
End DoDot:1
IF +VA200'>0
QUIT
+37 ;
+38 SET PRSESER=$$EN3^PRSEUTL3(+VA200)
+39 SET PRSESSN=$$GET1^DIQ(200,+VA200,9)
+40 IF PRSESSN=""
WRITE !,$CHAR(7),"NO SSN IN NEW PERSON FILE-CANNOT CONTINUE"
WRITE !
QUIT
+41 SET DA=$PIECE(^PRSE(452.8,DA(2),3,DA(1),1,0),U,3)+1
+42 SET (PRDA,PRSEEMP)=+VA200
+43 SET PRSENAM=$PIECE(VA200,U,2)
+44 SET PRSESER=$PIECE($GET(^PRSP(454.1,+$$EN3^PRSEUTL3($GET(PRDA)),0)),U)
+45 DO ADD
+46 QUIT
+47 ;
ADD ; PREVIOUS ATTENDANCE CHK
+1 IF +DATA>0
IF DATA(1)'<DATA
IF '$DATA(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP))
DO MSG17^PRSEMSG
QUIT
+2 NEW X
SET DA=($PIECE(^PRSE(452.8,DA(2),3,DA(1),1,0),U,3)+1)
IF $DATA(^PRSE(452,"AA",PRSETYP,PRSEEMP,PRSEPROG,(9999999-PRSEDAT)))
SET Y=PRSEDAT
DO DD^%DT
SET PRSEDAT=Y
SET PRSECLS=PRSEPROG
DO MSG18^PRSEMSG
QUIT
+3 IF '$DATA(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP))
Begin DoDot:1
ADD1 if PRSESER=""
SET PRSESER="NON-EMPLOYEE"
WRITE !!,"Do you want to register "_PRSENAM_" - "_PRSESER_" for",!,PRSEPROG
SET %=1
DO YN^DICN
IF %=0
WRITE $CHAR(7),!!,"Answer YES or NO."
GOTO ADD1
+1 IF '(%=1)&'(%=2)
SET POUT=1
QUIT
+2 QUIT
End DoDot:1
+3 IF '$GET(POUT)
IF $DATA(^PRSE(452.8,DA(2),3,DA(1),1,"B",+PRSEEMP))
SET DA=$ORDER(^(+PRSEEMP,0))
DO MSG7^PRSEMSG
DO DEL^PRSEED3
+4 if $GET(%)=2
QUIT
IF $GET(%)=1
KILL DD,DO
SET DIC="^PRSE(452.8,DA(2),3,DA(1),1,"
SET DIC("DR")="1////"_PRSESER_";3////"_PRSESSN_";4////^S X=""E"""
SET DIC(0)="L"
SET X=+PRSEEMP
SET DLAYGO=452.8894
DO FILE^DICN
+5 QUIT
QQ DO ^PRSEKILL
+1 QUIT
