source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNAHOC4.m@ 1608

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1SPNAHOC4 ;HISC/DAD-AD HOC REPORTS: MACRO OUTPUT ; [ 02/21/95 4:02 PM ]
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4EN1 ; *** Set the output macro flag
5 S SPNMOUTP=1
6 W !!?3,"You will be prompted for an output"
7 W !?3,"device when you exit the ",SPNTYPE(0)," menu. ",$C(7)
8 R SP:SPNDTIME
9 Q
10EN2 ; *** Print the macro report
11 K %ZIS,IOP S %ZIS="QM",%ZIS("A")=" Output macro to device: "
12 W ! D ^%ZIS G:POP EXIT I $D(IO("Q")) K IO("Q") D QVAR,^%ZTLOAD G EXIT
13ENTSK S SPNEXIT=0
14 U IO W:$E(IOST)="C" @IOF
15 W !?19,"=========================================="
16 W !?19,"|| AD HOC REPORT GENERATOR MACRO REPORT ||"
17 W !?19,"=========================================="
18 W !!!,"Report name: ",$E(SPNUNDL,1,67)
19 F SPNTYP="S","P" Q:SPNEXIT D
20 . W !!,$S(SPNTYP="S":"Sort",1:"Print")," fields:"
21 . W !,$E("-------------",1,13-(SPNTYP="S")),!!,"Macro: "
22 . S X=$P($G(SPNMACRO(SPNTYP)),U,2) W $S(X]"":X,1:$E(SPNUNDL,1,73))
23 . F SPNORDER=1:1:SPNMAXOP(SPNTYP) Q:SPNEXIT D
24 .. S SPNFIELD=$O(SPNOPTN(SPNTYP,SPNORDER,""))
25 .. S X=$G(SPNOPTN(SPNTYP,SPNORDER,+SPNFIELD))
26 .. S X(1)=$P(X,";"),X(1)=$TR(X(1),$TR(X(1),"+-&!@'#"))
27 .. S X(1)=X(1)_SPNFIELD_$S($P(X,";")]"":";"_$P(X,";",2,99),1:"")
28 .. I SPNTYP="S" D
29 ... S X=$G(FR(SPNORDER)),X(2)=$S(X]"":X,X(1)]"":"Beginning",1:"")
30 ... S X=$G(TO(SPNORDER)),X(3)=$S(X]"":X,X(1)]"":"Ending",1:"")
31 ... Q
32 .. I $D(SPNMACRO(SPNTYP)),X(1)]"" D
33 ... S SPND1=0 F SP=$L(X(1),";"):-1:1 D Q:SPND1
34 .... S SPND1=$O(^SPNL(154.8,+SPNMACRO(SPNTYP),"FLD","B",$P(X(1),";",1,SP),0))
35 .... Q
36 ... I SPND1 D
37 .... S SP=$G(^SPNL(154.8,+SPNMACRO(SPNTYP),"FLD",SPND1,0)),SPN=$G(^("FRTO"))
38 .... S X(1)=$P(SP,U)
39 .... I SPNTYP="S" F SPI=1,2 S X(SPI+1)=$S($P(SP,U,3):"Ask User",$P(SPN,U,SPI)]"":$E($P(SPN,U,SPI),1,30),SPI=1:"Beginning",1:"Ending")
40 .... Q
41 ... Q
42 .. W ! D PRNTFLD
43 .. Q
44 . D PAUSE
45 . Q
46 G:SPNEXIT EXIT
47 W ! D PRNTHDR(+$G(SPNMACRO("P")))
48 W ! D SORTHDR(+$G(SPNMACRO("S")))
49 W ?46,"Device: ",$E(SPNUNDL,1,26)
50 W:$E(IOST)'="C" @IOF
51EXIT ; *** Exit the macro report
52 D ^%ZISC S SPNMOUTP=0
53 S:$D(ZTQUEUED) ZTREQ="@"
54 Q
55PRNTFLD ; *** Inquire macro entry point
56 S SP=$G(SPNMENU(+SPNFIELD))
57 S SP=$S((SPNTYP="S")&(SP'>0):"",1:$P(SP,U,2))
58 W !?3,SPNORDER,") Field: "
59 W $S(SP]"":SP,SPNFIELD?1.N:"*** CORRUPTED ***",1:$E(SPNUNDL,1,30))
60 W !?6,"Entry: ",$S(X(1)]"":X(1),1:$E(SPNUNDL,1,30))
61 I SPNTYP="S" D
62 . W !?6,"From: ",$E($S(X(2)]"":X(2),1:SPNUNDL),1,30)
63 . W ?46,"To: ",$E($S(X(3)]"":X(3),1:SPNUNDL),1,30)
64 . Q
65 Q
66PRNTHDR(Y) ; *** Print DHD header
67 W !,"Header: ",$P($$DHD(Y),U,2)
68 Q
69SORTHDR(Y) ; *** Print DIPCRIT header
70 W !,"Sort criteria in report header: ",$P($$DIPCRIT(Y),U,2)
71 Q
72DHD(Y) ; *** Get Header
73 N X S X=$P($G(^SPNL(154.8,+Y,0)),U,6)
74 Q X_U_$S(X]"":X,1:$E(SPNUNDL,1,72))
75DIPCRIT(Y) ; *** Get DIPCRIT
76 N X S X=$P($G(^SPNL(154.8,+Y,0)),U,5),X=$S(X=0:2,X=1:1,1:0)
77 Q X_U_$S(X=1:"Yes",X=2:"No",1:"( Y / N )")
78PAUSE ; *** Pause at the end of page
79 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S SPNEXIT=$S(Y'>0:1,1:0)
80 Q
81QVAR ; *** Save variables for queueing
82 S ZTRTN="ENTSK^SPNAHOC4",ZTDESC="Ad Hoc Report Generator Macro Report"
83 F SP="FR(","SPNMAXOP(","SPNMENU(","SPNOPTN(","SPNTEMP","SPNMACRO(","TO(","SPNUNDL" S ZTSAVE(SP)=""
84 Q
Note: See TracBrowser for help on using the repository browser.