source: WorldVistAEHR/trunk/r/PAID-PRS/PRSERSTR.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1PRSERSTR ;HISC/MD-CLASS REGISTRATION ROSTER 10 MAR 93 ;10/17/00
2 ;;4.0;PAID;**62**;Sep 21, 1995
3EN1 ; REGISTRATION ROSTER
4 S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
5 S (NQ,NSW1,NPCT,POUT)=0
6 ;
7CLS D EN2^PRSEUTL3($G(DUZ)) S DIC=452.1,DIC(0)="AQEMZ",DIC("A")="CLASS NAME: "
8 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)"
9 S DIC("W")="S ZZ=$P(^(0),U,8) W ?($X+10),$P($G(^PRSP(454.1,ZZ,0)),U)"
10 D ^DIC K DIC,DLAYGO I $D(DTOUT)!($D(DUOUT))!(U[X)!'(+Y>0) S POUT=1 G Q
11 ;
12 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
13 ;
14 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)
15 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
16 I Y'>0 W @IOF G CLS
17 ;
18 S DA(1)=+Y,HDRDATE=Y(0,0) W ! S %ZIS("B")="",ZTRTN="START^PRSERSTR" D LOOP,DEV^PRSEUTL G:POP!($D(ZTSK)) Q
19 ;
20START K ^TMP("PRSE",$J),PRSEZD,PRSEZU S PRSE132=$S(IOM'<132:1,1:0),$P(PRSEZD,"-",132)="",$P(PRSEZU,"_",132)=""
21 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
22 . 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")
23 . 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"))=""
24 . Q
25 I ($O(^TMP("PRSE",$J,0))="") D HEADER W $C(7),!,"THERE ARE NO STUDENTS REGISTERED FOR THIS CLASS",! G QUIT
26 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
27 . S PRSESSN=0 F S PRSESSN=$O(^TMP("PRSE",$J,PRSENAM,PRSESER,PRSETL,PRSESSN)) Q:PRSESSN'>0!(POUT) D
28 .. I ($Y>(IOSL-6)!('NSW1)) D HEADER Q:POUT
29 .. W !,PRSENAM
30 ..;The following line of code was changed to not allow the SSN's to be
31 ..;displayed on this report due to privacy act concerns. To once again
32 ..;display SSN's mearly add back variable PRSESSN.
33 .. I PRSE132 D
34 ... W:'(PRSESER=" BLANK") ?31,$E(PRSESER,1,20)
35 ... W:'(PRSETL=" BLANK") ?52,$E(PRSETL,1,20)
36 ... W:'(PRSESSN=" BLANK") ?73,$E(PRSEZU,1,18)
37 ... W ?92,$E(PRSEZU,1,34),!
38 ... Q
39 .. E D
40 ... W:'(PRSESER=" BLANK") ?31,$E(PRSESER,1,14)
41 ... W:'(PRSETL=" BLANK") ?46,$E(PRSETL,1,14)
42 ... W:'(PRSESSN=" BLANK") ?61,$E(PRSEZU,1,14)
43 ... W ?76,$E(PRSEZU,1,4),!
44 ... Q
45 .. Q
46 . Q
47QUIT ; KILL ALL VARIBLES AND CLOSE DEVICE
48 I '$G(POUT) W ! F D Q:$Y>(IOSL-6)
49 . I PRSE132 D
50 .. W $E(PRSEZU,1,30),?31,$E(PRSEZU,1,20),?52,$E(PRSEZU,1,20)
51 .. W ?73,$E(PRSEZU,1,18),?92,$E(PRSEZU,1,34),!!
52 .. Q
53 . E D
54 .. W $E(PRSEZU,1,30),?31,$E(PRSEZU,1,14),?46,$E(PRSEZU,1,14)
55 .. W ?61,$E(PRSEZU,1,14),?76,$E(PRSEZU,1,4),!!
56 .. Q
57 . Q
58Q K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
59 Q
60HEADER ; PRINT REPORT HEADING
61 I 'POUT I 'NQ,$E(IOST)="C",NSW1 D ENDPG^PRSEUTL Q:POUT
62 S NSW1=1,NPCT=NPCT+1,Y=DT D DD^%DT
63 U IO W:$E(IOST)="C"!(NPCT>1) @IOF
64 I PRSE132 D
65 . W !,Y,?53,"CLASS REGISTRATION ROSTER",?121,"PAGE: ",NPCT
66 . W !!,"NAME",?31,"SERVICE",?52,"TITLE",?73,"SSN",?92,"SIGNATURE"
67 . Q
68 E D
69 . W !,Y,?27,"CLASS REGISTRATION ROSTER",?68,"PAGE: ",NPCT
70 . W !!,"NAME",?31,"SERVICE",?46,"TITLE",?61,"SSN",?72,"INITIALS"
71 . Q
72 W !,$E(PRSEZD,1,$S(PRSE132:132,1:80))
73 S PHD=HDRCLAS_" "_HDRDATE,PTAB=($S(PRSE132:132,1:80)-$L(PHD))\2
74 W !!,?PTAB,PHD,!
75 Q
76LOOP F X="PRSEMI","HDRCLAS","HDRDATE","DA(","NQ","NSW1","NPCT","POUT" S ZTSAVE(X)=""
77 Q
Note: See TracBrowser for help on using the repository browser.