[613] | 1 | SPNAHOC4 ;HISC/DAD-AD HOC REPORTS: MACRO OUTPUT ; [ 02/21/95 4:02 PM ]
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
---|
| 3 | ;
|
---|
| 4 | EN1 ; *** 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
|
---|
| 10 | EN2 ; *** 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
|
---|
| 13 | ENTSK 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
|
---|
| 51 | EXIT ; *** Exit the macro report
|
---|
| 52 | D ^%ZISC S SPNMOUTP=0
|
---|
| 53 | S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 54 | Q
|
---|
| 55 | PRNTFLD ; *** 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
|
---|
| 66 | PRNTHDR(Y) ; *** Print DHD header
|
---|
| 67 | W !,"Header: ",$P($$DHD(Y),U,2)
|
---|
| 68 | Q
|
---|
| 69 | SORTHDR(Y) ; *** Print DIPCRIT header
|
---|
| 70 | W !,"Sort criteria in report header: ",$P($$DIPCRIT(Y),U,2)
|
---|
| 71 | Q
|
---|
| 72 | DHD(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))
|
---|
| 75 | DIPCRIT(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 )")
|
---|
| 78 | PAUSE ; *** 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
|
---|
| 81 | QVAR ; *** 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
|
---|