source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNAHOC1.m@ 1305

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1SPNAHOC1 ;HISC/DAD-AD HOC REPORTS: SORT/PRINT SELECTION ;9/9/96 14:03
2 ;;2.0;Spinal Cord Dysfunction;**14,15**;01/02/1997
3 ;
4ENASK ; *** Prompt user for sort/print fields
5 S SPNNEXT=0 I SPNSEQ>SPNMAXOP(SPNTYPE) D Q
6 . W !!?3,"Maximum of ",SPNMAXOP(SPNTYPE)," ",SPNTYPE(0)
7 . W " fields reached. ",$C(7) R SP:SPNDTIME S SPNNEXT=1
8 . Q
9 D LIST
10 W !!?3,SPNTYPE(1)," selection # ",SPNSEQ," : "
11 R SPNSELOP:DTIME S:'$T SPNSELOP=U I SPNSELOP="^" K J,X,I,SPNARPT
12 I (SPNSEQ=1)&(SPNSELOP="") D G:SPNNONE=2 ENASK Q:SPNNEXT
13 . F D Q:%
14 .. S SPNNONE=2
15 .. W $C(7),!!?3,"You have not selected any "
16 .. W $S(SPNNUMOP("S")'>0:"sort or ",1:""),"print categories !!"
17 .. W !?3,"Do you wish to exit the program"
18 .. S %=1 D YN^DICN S SPNNONE=% I '% W !!?5,SPNYESNO
19 .. Q
20 . Q:SPNNONE=2
21 . S (SPNNEXT,SPNQUIT)=1 W !!?3,"No report will be produced." K J,X,I,SPNARPT
22 . Q:(SPNNONE=-1)!(SPNMOUTP'>0)
23 . F D Q:%
24 .. W !!?3,"You previously asked for macro output, do you still want it"
25 .. S %=2 D YN^DICN I '% W !!?5,SPNYESNO
26 .. Q
27 . D:%=1 EN2^SPNAHOC4
28 . Q
29 S:SPNSELOP="" SPNNEXT=1 S:$E(SPNSELOP)=U (SPNNEXT,SPNQUIT)=1
30 Q:SPNNEXT!SPNQUIT
31 I $E(SPNSELOP)="[" D Q:SPNNEXT G:SPNMLOAD'>0 ENASK S SPNNEXT=1 Q
32 . D ^SPNAHOC3,HELP:SPNSELOP=-1
33 . Q
34 I SPNSELOP["," D S SPNNEXT='SPNAGIN Q:SPNNEXT G ENASK
35 . S SPNAGIN=0,SPNLIST=SPNSELOP
36 . I SPNSEQ>1 D S SPNAGIN=1 Q
37 .. W !!?3,SPNTYPE(1)," lists may only be entered at the"
38 .. W " first ",SPNTYPE(0)," selection prompt !! ",$C(7) R SP:SPNDTIME
39 .. Q
40 . I $L(SPNLIST,",")>SPNMAXOP(SPNTYPE) D S SPNAGIN=1 Q
41 .. W !!?3,"Too many ",SPNTYPE(0)," fields chosen !! ",$C(7) R SP:SPNDTIME
42 .. Q
43 . F SPNLST=1:1:$L(SPNSELOP,",") D Q:SPNAGIN
44 .. S SPNSELOP=$P(SPNLIST,",",SPNLST),SPNSEQ=SPNLST D CHECK
45 .. Q
46 . S SPNSEQ=SPNSEQ+1 Q:'SPNAGIN
47 . I SPNTYPE="S" K FR,TO
48 . K SPNCHOSN,SPNOPTN(SPNTYPE) S SPNSEQ=1
49 . Q
50 S (SPNAGIN,SPNLST)=0 D CHECK G:SPNAGIN ENASK
51 Q
52CHECK ; *** Check user's input
53 S SPNPREFX(0)=$S(SPNTYPE="S":"+-!#@'",1:"&!+#") D FIX^SPNAHOC2
54 S SPNPREFX(SPNTYPE,SPNSEQ)=SPNPREFX,SPNSUFFX(SPNTYPE,SPNSEQ)=SPNSUFFX
55 I SPNTYPE="P",$L(SPNPREFX)>1 S (SPNSELOP,SPNPREFX)=""
56 I SPNLST'>0 W " ",$P($G(SPNMENU(+SPNSELOP)),U,2)
57 E W:SPNTYPE="S" !!?3,"Sort by: ",$P($G(SPNMENU(+SPNSELOP)),U,2)
58 I $S(SPNSELOP<1:1,SPNSELOP>SPNMMAX:1,SPNSELOP'?1.N:1,$D(SPNMENU(SPNSELOP))[0:1,1:0) D HELP S SPNAGIN=1 Q
59 I $D(SPNCHOSN(SPNSELOP))#2 D S SPNAGIN=1 Q
60 . W $C(7),!!?3,"You have already chosen item ",SPNSELOP,", "
61 . W $P(SPNMENU(SPNSELOP),U,2),",",!?3,"as a ",SPNTYPE(0)," field !! "
62 . W "Please re-enter your selection. " R SP:SPNDTIME
63 . Q
64 I SPNTYPE="S",SPNMENU(SPNSELOP)'>0 D Q
65 . W !!?3,"You are not allowed to sort by "
66 . W $P(SPNMENU(SPNSELOP),U,2)," !! ",$C(7)
67 . R SP:SPNDTIME S SPNAGIN=1
68 . Q
69 I SPNTYPE="S" D Q:SPNAGIN
70 . S SPNDIR(0)=$P($P(SPNMENU(SPNSELOP),U,4,99),"|")
71 . S SPNDIR("S")=$P(SPNMENU(SPNSELOP),"|",2)
72 . D ^SPNAHOC2 I SPNQUIT!SPNNEXT S (SPNQUIT,SPNNEXT)=0 S SPNAGIN=1
73 . Q
74 S X=$P(SPNMENU(SPNSELOP),U,3),X=$P(X,"~")_SPNPREFX_$P(X,"~",2)
75 S X(0)=$P(X,";"),X(1)=$P($P(X,";"""),";",2,99),X("T")=$P(X,";""",2)
76 S SPNSUFFX(1)=$P(SPNSUFFX,";"""),SPNSUFFX("T")=$P(SPNSUFFX,";""",2)
77 S SPN=X(0)_$S(SPNSUFFX(1)]"":SPNSUFFX(1),X(1)]"":";"_X(1),1:"")
78 S X=SPN_$S(SPNSUFFX("T")]"":";"""_SPNSUFFX("T"),X("T")]"":";"""_X("T"),1:"")
79 S SPNOPTN(SPNTYPE,SPNSEQ,SPNSELOP)=X,SPNCHOSN(SPNSELOP)=$C(96+SPNSEQ)
80 Q
81LIST ; *** Display the sort/print menus
82 W @IOF
83 I $G(SPNMHDR)'="@" D
84 . S X=$S($G(SPNMHDR)]"":$E(SPNMHDR,1,45)_" ",1:"")
85 . S X=X_"Ad Hoc Report Generator"
86 . S Y="",$P(Y,"=",70-$L(X)/2)=""
87 . W " ",Y," ",X," ",Y,!
88 . Q
89 S Y=1,SPN=$Y,SPNMMAX(0)=SPNMMAX#2+SPNMMAX\3+1
90 F SP=1:1:SPNMMAX(0) D Q:Y'>0
91 . S SPI=SP,SPNTAB=0 D S SPI=SP+SPNMMAX(0),SPNTAB=24 D S SPI=SPI+SPNMMAX(0),SPNTAB=50 D
92 .. Q:$D(SPNMENU(SPI))[0
93 .. W:SPNTAB=0 ! W ?SPNTAB,$S(SPNTYPE="P"!SPNMENU(SPI):$J(SPI,2),1:" ")
94 .. W $S($D(SPNCHOSN(SPI)):SPNCHOSN(SPI),1:" ")
95 .. W $E($P(SPNMENU(SPI),U,2),1,26)
96 .. Q
97 . I $Y>(IOSL+SPN-3) S SPN=$Y K DIR S DIR(0)="E" D ^DIR K DIR
98 . Q
99 Q
100 ; changed to make room for three new fields (IOSL+SPN-3) was -4
101HELP ; *** Display the sort/print help screens
102 I $E(SPNSELOP)'="?" W " ??",$C(7),!
103 E W @IOF
104 W !,"Select the ",$S(SPNSEQ=1:$S(SPNTYPE="S":"major",1:"first"),1:"next")
105 W " data element to ",$S(SPNTYPE="S":"sort by",1:"print")
106 W ". Maximum of ",SPNMAXOP(SPNTYPE)," ",SPNTYPE(0)," fields allowed."
107 W !,SPNBLURB,$S(SPNSEQ>1:", 'abc' indicates order chosen",1:""),".",!
108 D:$E(SPNSELOP)="?" EN^SPNAHOCH($S(SPNTYPE="S":"H1",1:"H2"))
109 R SP:(2*SPNDTIME)
110 Q
Note: See TracBrowser for help on using the repository browser.