| 1 | PRSECAL ;HISC/MH-CALENDAR OF CLASSES BY SERVICE AND DATE ;9/17/1998
|
|---|
| 2 | ;;4.0;PAID;**44**;Sep 21, 1995
|
|---|
| 3 | EN1 ;ENTRY POINT FOR PRSE-CAL
|
|---|
| 4 | S X=$G(^PRSE(452.7,1,"OFF")) I X=""!(X=1) D MSG6^PRSEMSG Q
|
|---|
| 5 | D EN2^PRSEUTL3($G(DUZ)) I PRSESER=""&'(DUZ(0)="@") D MSG3^PRSEMSG G Q
|
|---|
| 6 | S (PRSECAL,NQ,NQT,NSW1,NPC,NOUT,PSPC,PSP)=0,NSW2=1
|
|---|
| 7 | D DATSEL^PRSEUTL G Q:$G(POUT) D SRT^PRSEUTL1 G Q:$G(POUT)
|
|---|
| 8 | I $$EN4^PRSEUTL3($G(DUZ))!(DUZ(0)["@") D EN3^PRSEUTL1 G Q:$G(POUT)
|
|---|
| 9 | I $G(PSP)=0,$G(PSPC)=0 S PSPC=PRSESER("TX")
|
|---|
| 10 | W ! S ZTRTN="START^PRSECAL" D L,DEV^PRSEUTL G:POP!($D(ZTSK)) Q
|
|---|
| 11 | START ;
|
|---|
| 12 | K ^TMP("PRSE",$J)
|
|---|
| 13 | S PRSE132=$S(IOM'<132:1,1:0)
|
|---|
| 14 | F DA=0:0 S DA=$O(^PRSE(452.8,DA)) Q:DA'>0 I $P($G(^PRSE(452.8,DA,0)),U,21)'=""!(DUZ(0)="@") D SORT
|
|---|
| 15 | S X=$O(^TMP("PRSE",$J,0)) I X="" D NHDR W !,"THERE IS NO DATA FOR THIS REPORT" G QUIT
|
|---|
| 16 | D NPRINT
|
|---|
| 17 | QUIT ;
|
|---|
| 18 | Q K ^TMP("PRSE",$J) D CLOSE^PRSEUTL,^PRSEKILL
|
|---|
| 19 | Q
|
|---|
| 20 | NPRINT ;
|
|---|
| 21 | NO S PRSESP1="" F I=0:0 S PRSESP1=$O(^TMP("PRSE",$J,"L",PRSESP1)) Q:PRSESP1="" D NP Q:NQT
|
|---|
| 22 | Q
|
|---|
| 23 | NP S PRSESP2="" F S PRSESP2=$O(^TMP("PRSE",$J,"L",PRSESP1,PRSESP2)) Q:PRSESP2="" S NSORT=$G(^TMP("PRSE",$J,"L",PRSESP1,PRSESP2)) D:NSORT NP1 Q:NQT
|
|---|
| 24 | Q
|
|---|
| 25 | NP1 S PRSETYP="" F S PRSETYP=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETYP)) Q:PRSETYP="" D NQ Q:NQT
|
|---|
| 26 | Q
|
|---|
| 27 | NQ S PRSELNG=0 F S PRSELNG=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETYP,PRSELNG)) Q:PRSELNG'>0 D NR Q:NQT
|
|---|
| 28 | Q
|
|---|
| 29 | NR S PRSELOC="" F S PRSELOC=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETYP,PRSELNG,PRSELOC)) Q:PRSELOC="" D NS Q:NQT
|
|---|
| 30 | Q
|
|---|
| 31 | NS S PRSESVC="" F S PRSESVC=$O(^TMP("PRSE",$J,"L1",NSORT,PRSETYP,PRSELNG,PRSELOC,PRSESVC)) Q:PRSESVC="" D NPPRINT Q:NQT
|
|---|
| 32 | Q
|
|---|
| 33 | NPPRINT I ($Y>(IOSL-9)!('NSW1)) D NHDR Q:NQT
|
|---|
| 34 | S Y=$S(PRSESEL="D":PRSESP1,PRSESEL="C":PRSESP2,1:0)
|
|---|
| 35 | S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_$S((+$P(Y,".",2)>0):"@"_$P(Y,".",2),1:"") I +$P(Y,"@",2)>0 S $P(Y,"@",2)=$S($P(Y,"@",2)?2N:$P(Y,"@",2)_"00",$P(Y,"@",2)?1N:$P(Y,"@",2)_"0",$P(Y,"@",2)?3N:$P(Y,"@",2)_"0",1:$P(Y,"@",2))
|
|---|
| 36 | I PRSE132 D
|
|---|
| 37 | . I PRSESEL="D" W:Y'="" !,Y W:'(PRSESP2=" BLANK") ?19,$E(PRSESP2,1,36)
|
|---|
| 38 | . I PRSESEL="C" W:PRSESP2'=" BLANK" !,$E(PRSESP1,1,36) W:'(Y="") ?40,Y
|
|---|
| 39 | . W:PRSELNG'=" BLANK" ?58,PRSELNG
|
|---|
| 40 | . W:PRSETYP'=" BLANK" ?68,PRSETYP
|
|---|
| 41 | . W:PRSELOC'=" BLANK" ?73,$E(PRSELOC,1,25)
|
|---|
| 42 | . W:PRSESVC'=" BLANK" ?101,PRSESVC
|
|---|
| 43 | . Q
|
|---|
| 44 | E D
|
|---|
| 45 | . I PRSESEL="D" W:Y'="" !,Y W:'(PRSESP2=" BLANK") ?14,$E(PRSESP2,1,19)
|
|---|
| 46 | . I PRSESEL="C" W:PRSESP2'=" BLANK" !,$E(PRSESP1,1,19) W:'(Y="") ?24,Y
|
|---|
| 47 | . W:PRSETYP'="" ?38,PRSETYP
|
|---|
| 48 | . W:PRSELNG'=" BLANK" ?42,PRSELNG
|
|---|
| 49 | . W:PRSELOC'=" BLANK" ?48,$E(PRSELOC,1,15)
|
|---|
| 50 | . W:PRSESVC'=" BLANK" ?64,$E(PRSESVC,1,15)
|
|---|
| 51 | . Q
|
|---|
| 52 | Q
|
|---|
| 53 | NHDR I 'NOUT I 'NQ,NSW1,$E(IOST)="C" D ENDPG^PRSEUTL S NQT=+POUT Q:NQT
|
|---|
| 54 | S NPC=NPC+1,NSW1=1 W:$E(IOST)="C"!(NPC>1) @IOF S X="T" D ^%DT D:+Y D^DIQ
|
|---|
| 55 | I PRSE132 D
|
|---|
| 56 | . W Y,?52,"CLASS REGISTRATION CALENDAR",?120,"PAGE: ",NPC,!!
|
|---|
| 57 | . W:PRSESEL="D" "START DATE",?19,"CLASS TITLE"
|
|---|
| 58 | . W:PRSESEL="C" "CLASS TITLE",?40,"START DATE"
|
|---|
| 59 | . W ?58,"LENGTH",?66,"TYPE",?73,"LOCATION",?101,"SERVICE",!
|
|---|
| 60 | . Q
|
|---|
| 61 | E D
|
|---|
| 62 | . W Y,?26,"CLASS REGISTRATION CALENDAR",?68,"PAGE: ",NPC,!!
|
|---|
| 63 | . W:PRSESEL="D" "START DATE",?14,"CLASS TITLE",?35,"TYPE"
|
|---|
| 64 | . W:PRSESEL="C" "CLASS TITLE",?22,"START DATE",?35,"TYPE"
|
|---|
| 65 | . W ?40,"LENGTH",?48,"LOCATION",?64,"SERVICE",!
|
|---|
| 66 | . Q
|
|---|
| 67 | S NI="",$P(NI,"-",$S(PRSE132:133,1:81))="" W NI,!
|
|---|
| 68 | Q
|
|---|
| 69 | L F X="PRSECLS","PRSESEL","PRSESER","NSW2","NOUT","NQ","NQT","NSW1","PSPC","NPC","PSP" S ZTSAVE(X)=""
|
|---|
| 70 | Q
|
|---|
| 71 | SORT ; SORT SERVICE DATA
|
|---|
| 72 | W:$E(IOST,1,2)="C-"&('$R(100)) "."
|
|---|
| 73 | S N0=$P($G(^PRSE(452.8,+DA,0)),U),DATA=$G(^PRSE(452.1,+N0,0))
|
|---|
| 74 | ;I $P(DATA,U,8)'=PRSESER&$P(DATA,U,9)!($G(DATA)="") Q
|
|---|
| 75 | I PRSESEL="C" S PRSESP1=$S($D(^PRSE(452.1,+N0,0)):$P($G(^(0)),U),1:" BLANK")
|
|---|
| 76 | I PRSESEL="D" S PRSESP2=$S($D(^PRSE(452.1,+N0,0)):$P($G(^(0)),U),1:" BLANK")
|
|---|
| 77 | S PRSELNG=$S('($P($G(^PRSE(452.8,DA,0)),U,18)=""):$P(^(0),U,18),1:" BLANK"),PRSETYP=$S('($P($G(^(0)),U,5)=""):$P(^(0),U,5),1:" BLANK")
|
|---|
| 78 | S N1=$P($G(^PRSE(452.8,DA,0)),U,21),PRSESVC=$S($D(^PRSP(454.1,+N1,0)):$P($G(^(0)),U),1:" BLANK")
|
|---|
| 79 | I '$G(PSP),PRSESVC'=PSPC,$P($G(DATA),U,9) Q
|
|---|
| 80 | F D1=0:0 S D1=$O(^PRSE(452.8,DA,3,D1)) Q:D1'>0 D SET
|
|---|
| 81 | Q
|
|---|
| 82 | SET ;
|
|---|
| 83 | S:TYP="S"!(YRST<DT) YRST=DT I +(^PRSE(452.8,DA,3,D1,0)<YRST)!(+^PRSE(452.8,DA,3,D1,0)>YREND) Q
|
|---|
| 84 | I $D(^PRSE(452.8,DA,3,D1,0)),PRSESEL="D" S PRSESP1=$S((+^(0)>0):+^(0),1:0)
|
|---|
| 85 | I $D(^PRSE(452.8,DA,3,D1,0)),PRSESEL="C" S PRSESP2=$S((+^(0)>0):+^(0),1:0)
|
|---|
| 86 | S PRSELOC=$S('($P(^PRSE(452.8,DA,3,D1,0),U,2)=""):$P(^(0),U,2),1:" BLANK") D SAVE
|
|---|
| 87 | Q
|
|---|
| 88 | SAVE S:PRSESP1="" PRSESP1=" " S:PRSESP2="" PRSESP2=" "
|
|---|
| 89 | S:$G(NSORT)="" NSORT=1
|
|---|
| 90 | N X S X=$G(^TMP("PRSE",$J,"L",PRSESP1,PRSESP2))
|
|---|
| 91 | I X="" S X=NSORT,NSORT=NSORT+1,^TMP("PRSE",$J,"L",PRSESP1,PRSESP2)=X
|
|---|
| 92 | S ^TMP("PRSE",$J,"L1",X,PRSETYP,PRSELNG,PRSELOC,PRSESVC)=""
|
|---|
| 93 | Q
|
|---|
