source: FOIAVistA/trunk/r/PAID-PRS/PRSERSTR.m@ 1154

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
HEADER ; PRINT REPORT HEADING
 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