PRSERSTR ;HISC/MD-CLASS REGISTRATION ROSTER 10 MAR 93 ;10/17/00
;;4.0;PAID;**62**;Sep 21, 1995
EN1 ; REGISTRATION ROSTER
S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
S (NQ,NSW1,NPCT,POUT)=0
;
CLS D EN2^PRSEUTL3($G(DUZ)) S DIC=452.1,DIC(0)="AQEMZ",DIC("A")="CLASS NAME: "
S DIC("S")="S YY=+$O(^PRSE(452.8,""B"",+Y,0)) I (DUZ(0)[""@""!($$EN4^PRSEUTL3($G(DUZ))!(PRSESER=$P(^PRSE(452.1,+Y,0),U,8)!($P(^(0),U,9)=0)))),$D(^PRSE(452.8,+YY,3,""C"")),9999999-$O(^PRSE(452.8,+YY,3,""C"",0))'<(DT-1)"
S DIC("W")="S ZZ=$P(^(0),U,8) W ?($X+10),$P($G(^PRSP(454.1,ZZ,0)),U)"
D ^DIC K DIC,DLAYGO I $D(DTOUT)!($D(DUOUT))!(U[X)!'(+Y>0) S POUT=1 G Q
;
S PRSEMI=+Y,X=$P(Y,U,2),DIC="^PRSE(452.8,",DIC(0)="E",DIC("S")="I $P(^(0),U)=PRSEMI" D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S POUT=1 G Q
;
S DA(2)=+Y,Y=$S($D(^PRSE(452.8,DA(2),3,"C")):9999999-$O(^PRSE(452.8,DA(2),3,"C",0)),1:"") D:+Y D^DIQ S:'(Y="") DIC("B")=Y S HDRCLAS=Y(0,0)
S DIC(0)="AEMQZ",DIC="^PRSE(452.8,DA(2),3,",DIC("A")="Select DATE: ",DIC("S")="I +^(0)'<(DT-1)",DIC("W")="I $P(^(0),U,5)=0 W ?($X+1),""* REGISTRATION UNAVAILABLE *""" D ^DIC K DIC I $D(DTOUT)!($D(DUOUT))!(U[X) S POUT=1 G Q
I Y'>0 W @IOF G CLS
;
S DA(1)=+Y,HDRDATE=Y(0,0) W ! S %ZIS("B")="",ZTRTN="START^PRSERSTR" D LOOP,DEV^PRSEUTL G:POP!($D(ZTSK)) Q
;
START K ^TMP("PRSE",$J),PRSEZD,PRSEZU S PRSE132=$S(IOM'<132:1,1:0),$P(PRSEZD,"-",132)="",$P(PRSEZU,"_",132)=""
F PRSEDA=0:0 S PRSEDA=$O(^PRSE(452.8,DA(2),3,DA(1),1,PRSEDA)) Q:PRSEDA'>0 I $D(^PRSE(452.8,DA(2),3,DA(1),1,PRSEDA,0)) S PRSEDATA=^(0) D
. S PRSENAM=$S($P($G(^VA(200,+PRSEDATA,0)),U)'="":$P(^(0),U),1:" BLANK"),SSN=$S($P($G(^VA(200,+PRSEDATA,1)),U,9):$P(^(1),U,9),1:" BLANK"),PRSETL=$S($$EN10^PRSEUTL3($G(SSN))'="":$$EN10^PRSEUTL3($G(SSN)),1:" BLANK")
. S ^TMP("PRSE",$J,PRSENAM,$S('($P(PRSEDATA,U,2)=""):$P(PRSEDATA,U,2),1:" BLANK"),PRSETL,$S('($P(PRSEDATA,U,4)=""):$P(PRSEDATA,U,4),1:" BLANK"))=""
. Q
I ($O(^TMP("PRSE",$J,0))="") D HEADER W $C(7),!,"THERE ARE NO STUDENTS REGISTERED FOR THIS CLASS",! G QUIT
S PRSENAM="" F S PRSENAM=$O(^TMP("PRSE",$J,PRSENAM)) Q:PRSENAM="" S PRSESER="" F S PRSESER=$O(^TMP("PRSE",$J,PRSENAM,PRSESER)) Q:PRSESER="" S PRSETL="" F S PRSETL=$O(^TMP("PRSE",$J,PRSENAM,PRSESER,PRSETL)) Q:PRSETL=""!(POUT) D
. S PRSESSN=0 F S PRSESSN=$O(^TMP("PRSE",$J,PRSENAM,PRSESER,PRSETL,PRSESSN)) Q:PRSESSN'>0!(POUT) D
.. I ($Y>(IOSL-6)!('NSW1)) D HEADER Q:POUT
.. W !,PRSENAM
..;The following line of code was changed to not allow the SSN's to be
..;displayed on this report due to privacy act concerns. To once again
..;display SSN's mearly add back variable PRSESSN.
.. I PRSE132 D
... W:'(PRSESER=" BLANK") ?31,$E(PRSESER,1,20)
... W:'(PRSETL=" BLANK") ?52,$E(PRSETL,1,20)
... W:'(PRSESSN=" BLANK") ?73,$E(PRSEZU,1,18)
... W ?92,$E(PRSEZU,1,34),!
... Q
.. E D
... W:'(PRSESER=" BLANK") ?31,$E(PRSESER,1,14)
... W:'(PRSETL=" BLANK") ?46,$E(PRSETL,1,14)
... W:'(PRSESSN=" BLANK") ?61,$E(PRSEZU,1,14)
... W ?76,$E(PRSEZU,1,4),!
... Q
.. Q
. Q
QUIT ; KILL ALL VARIBLES AND CLOSE DEVICE
I '$G(POUT) W ! F D Q:$Y>(IOSL-6)
. I PRSE132 D
.. W $E(PRSEZU,1,30),?31,$E(PRSEZU,1,20),?52,$E(PRSEZU,1,20)
.. W ?73,$E(PRSEZU,1,18),?92,$E(PRSEZU,1,34),!!
.. Q
. E D
.. W $E(PRSEZU,1,30),?31,$E(PRSEZU,1,14),?46,$E(PRSEZU,1,14)
.. W ?61,$E(PRSEZU,1,14),?76,$E(PRSEZU,1,4),!!
.. Q
. Q
Q K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
Q
I 'POUT I 'NQ,$E(IOST)="C",NSW1 D ENDPG^PRSEUTL Q:POUT
S NSW1=1,NPCT=NPCT+1,Y=DT D DD^%DT
U IO W:$E(IOST)="C"!(NPCT>1) @IOF
I PRSE132 D
. W !,Y,?53,"CLASS REGISTRATION ROSTER",?121,"PAGE: ",NPCT
. W !!,"NAME",?31,"SERVICE",?52,"TITLE",?73,"SSN",?92,"SIGNATURE"
. Q
E D
. W !,Y,?27,"CLASS REGISTRATION ROSTER",?68,"PAGE: ",NPCT
. W !!,"NAME",?31,"SERVICE",?46,"TITLE",?61,"SSN",?72,"INITIALS"
. Q
W !,$E(PRSEZD,1,$S(PRSE132:132,1:80))
S PHD=HDRCLAS_" "_HDRDATE,PTAB=($S(PRSE132:132,1:80)-$L(PHD))\2
W !!,?PTAB,PHD,!
Q
LOOP F X="PRSEMI","HDRCLAS","HDRDATE","DA(","NQ","NSW1","NPCT","POUT" S ZTSAVE(X)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSERSTR 4135 printed Nov 22, 2024@17:36:53 Page 2
PRSERSTR ;HISC/MD-CLASS REGISTRATION ROSTER 10 MAR 93 ;10/17/00
+1 ;;4.0;PAID;**62**;Sep 21, 1995
EN1 ; REGISTRATION ROSTER
+1 SET X=$GET(^PRSE(452.7,1,"OFF"))
IF X=""!(X=1)
DO MSG6^PRSEMSG
QUIT
+2 SET (NQ,NSW1,NPCT,POUT)=0
+3 ;
CLS DO EN2^PRSEUTL3($GET(DUZ))
SET DIC=452.1
SET DIC(0)="AQEMZ"
SET DIC("A")="CLASS NAME: "
+1 SET DIC("S")="S YY=+$O(^PRSE(452.8,""B"",+Y,0)) I (DUZ(0)[""@""!($$EN4^PRSEUTL3($G(DUZ))!(PRSESER=$P(^PRSE(452.1,+Y,0),U,8)!($P(^(0),U,9)=0)))),$D(^PRSE(452.8,+YY,3,""C"")),9999999-$O(^PRSE(452.8,+YY,3,""C"",0))'<(DT-1)"
+2 SET DIC("W")="S ZZ=$P(^(0),U,8) W ?($X+10),$P($G(^PRSP(454.1,ZZ,0)),U)"
+3 DO ^DIC
KILL DIC,DLAYGO
IF $DATA(DTOUT)!($DATA(DUOUT))!(U[X)!'(+Y>0)
SET POUT=1
GOTO Q
+4 ;
+5 SET PRSEMI=+Y
SET X=$PIECE(Y,U,2)
SET DIC="^PRSE(452.8,"
SET DIC(0)="E"
SET DIC("S")="I $P(^(0),U)=PRSEMI"
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET POUT=1
GOTO Q
+6 ;
+7 SET DA(2)=+Y
SET Y=$SELECT($DATA(^PRSE(452.8,DA(2),3,"C")):9999999-$ORDER(^PRSE(452.8,DA(2),3,"C",0)),1:"")
if +Y
DO D^DIQ
if '(Y="")
SET DIC("B")=Y
SET HDRCLAS=Y(0,0)
+8 SET DIC(0)="AEMQZ"
SET DIC="^PRSE(452.8,DA(2),3,"
SET DIC("A")="Select DATE: "
SET DIC("S")="I +^(0)'<(DT-1)"
SET DIC("W")="I $P(^(0),U,5)=0 W ?($X+1),""* REGISTRATION UNAVAILABLE *"""
DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))!(U[X)
SET POUT=1
GOTO Q
+9 IF Y'>0
WRITE @IOF
GOTO CLS
+10 ;
+11 SET DA(1)=+Y
SET HDRDATE=Y(0,0)
WRITE !
SET %ZIS("B")=""
SET ZTRTN="START^PRSERSTR"
DO LOOP
DO DEV^PRSEUTL
if POP!($DATA(ZTSK))
GOTO Q
+12 ;
START KILL ^TMP("PRSE",$JOB),PRSEZD,PRSEZU
SET PRSE132=$SELECT(IOM'<132:1,1:0)
SET $PIECE(PRSEZD,"-",132)=""
SET $PIECE(PRSEZU,"_",132)=""
+1 FOR PRSEDA=0:0
SET PRSEDA=$ORDER(^PRSE(452.8,DA(2),3,DA(1),1,PRSEDA))
if PRSEDA'>0
QUIT
IF $DATA(^PRSE(452.8,DA(2),3,DA(1),1,PRSEDA,0))
SET PRSEDATA=^(0)
Begin DoDot:1
+2 SET PRSENAM=$SELECT($PIECE($GET(^VA(200,+PRSEDATA,0)),U)'="":$PIECE(^(0),U),1:" BLANK")
SET SSN=$SELECT($PIECE($GET(^VA(200,+PRSEDATA,1)),U,9):$PIECE(^(1),U,9),1:" BLANK")
SET PRSETL=$SELECT($$EN10^PRSEUTL3($GET(SSN))'="":$$EN10^PRSEUTL3($GET(SSN)),1:" BLANK")
+3 SET ^TMP("PRSE",$JOB,PRSENAM,$SELECT('($PIECE(PRSEDATA,U,2)=""):$PIECE(PRSEDATA,U,2),1:" BLANK"),PRSETL,$SELECT('($PIECE(PRSEDATA,U,4)=""):$PIECE(PRSEDATA,U,4),1:" BLANK"))=""
+4 QUIT
End DoDot:1
+5 IF ($ORDER(^TMP("PRSE",$JOB,0))="")
DO HEADER
WRITE $CHAR(7),!,"THERE ARE NO STUDENTS REGISTERED FOR THIS CLASS",!
GOTO QUIT
+6 SET PRSENAM=""
FOR
SET PRSENAM=$ORDER(^TMP("PRSE",$JOB,PRSENAM))
if PRSENAM=""
QUIT
SET PRSESER=""
FOR
SET PRSESER=$ORDER(^TMP("PRSE",$JOB,PRSENAM,PRSESER))
if PRSESER=""
QUIT
SET PRSETL=""
FOR
SET PRSETL=$ORDER(^TMP("PRSE",$JOB,PRSENAM,PRSESER,PRSETL))
if PRSETL=""!(POUT)
QUIT
Begin DoDot:1
+7 SET PRSESSN=0
FOR
SET PRSESSN=$ORDER(^TMP("PRSE",$JOB,PRSENAM,PRSESER,PRSETL,PRSESSN))
if PRSESSN'>0!(POUT)
QUIT
Begin DoDot:2
+8 IF ($Y>(IOSL-6)!('NSW1))
DO HEADER
if POUT
QUIT
+9 WRITE !,PRSENAM
+10 ;The following line of code was changed to not allow the SSN's to be
+11 ;displayed on this report due to privacy act concerns. To once again
+12 ;display SSN's mearly add back variable PRSESSN.
+13 IF PRSE132
Begin DoDot:3
+14 if '(PRSESER=" BLANK")
WRITE ?31,$EXTRACT(PRSESER,1,20)
+15 if '(PRSETL=" BLANK")
WRITE ?52,$EXTRACT(PRSETL,1,20)
+16 if '(PRSESSN=" BLANK")
WRITE ?73,$EXTRACT(PRSEZU,1,18)
+17 WRITE ?92,$EXTRACT(PRSEZU,1,34),!
+18 QUIT
End DoDot:3
+19 IF '$TEST
Begin DoDot:3
+20 if '(PRSESER=" BLANK")
WRITE ?31,$EXTRACT(PRSESER,1,14)
+21 if '(PRSETL=" BLANK")
WRITE ?46,$EXTRACT(PRSETL,1,14)
+22 if '(PRSESSN=" BLANK")
WRITE ?61,$EXTRACT(PRSEZU,1,14)
+23 WRITE ?76,$EXTRACT(PRSEZU,1,4),!
+24 QUIT
End DoDot:3
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
QUIT ; KILL ALL VARIBLES AND CLOSE DEVICE
+1 IF '$GET(POUT)
WRITE !
FOR
Begin DoDot:1
+2 IF PRSE132
Begin DoDot:2
+3 WRITE $EXTRACT(PRSEZU,1,30),?31,$EXTRACT(PRSEZU,1,20),?52,$EXTRACT(PRSEZU,1,20)
+4 WRITE ?73,$EXTRACT(PRSEZU,1,18),?92,$EXTRACT(PRSEZU,1,34),!!
+5 QUIT
End DoDot:2
+6 IF '$TEST
Begin DoDot:2
+7 WRITE $EXTRACT(PRSEZU,1,30),?31,$EXTRACT(PRSEZU,1,14),?46,$EXTRACT(PRSEZU,1,14)
+8 WRITE ?61,$EXTRACT(PRSEZU,1,14),?76,$EXTRACT(PRSEZU,1,4),!!
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
if $Y>(IOSL-6)
QUIT
Q KILL ^TMP("PRSE",$JOB)
DO CLOSE^PRSEUTL
DO ^PRSEKILL
+1 QUIT
+1 IF 'POUT
IF 'NQ
IF $EXTRACT(IOST)="C"
IF NSW1
DO ENDPG^PRSEUTL
if POUT
QUIT
+2 SET NSW1=1
SET NPCT=NPCT+1
SET Y=DT
DO DD^%DT
+3 USE IO
if $EXTRACT(IOST)="C"!(NPCT>1)
WRITE @IOF
+4 IF PRSE132
Begin DoDot:1
+5 WRITE !,Y,?53,"CLASS REGISTRATION ROSTER",?121,"PAGE: ",NPCT
+6 WRITE !!,"NAME",?31,"SERVICE",?52,"TITLE",?73,"SSN",?92,"SIGNATURE"
+7 QUIT
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !,Y,?27,"CLASS REGISTRATION ROSTER",?68,"PAGE: ",NPCT
+10 WRITE !!,"NAME",?31,"SERVICE",?46,"TITLE",?61,"SSN",?72,"INITIALS"
+11 QUIT
End DoDot:1
+12 WRITE !,$EXTRACT(PRSEZD,1,$SELECT(PRSE132:132,1:80))
+13 SET PHD=HDRCLAS_" "_HDRDATE
SET PTAB=($SELECT(PRSE132:132,1:80)-$LENGTH(PHD))\2
+14 WRITE !!,?PTAB,PHD,!
+15 QUIT
LOOP FOR X="PRSEMI","HDRCLAS","HDRDATE","DA(","NQ","NSW1","NPCT","POUT"
SET ZTSAVE(X)=""
+1 QUIT
