source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW22.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1SCRPW22 ;RENO/KEITH - ACRP Ad Hoc Report (cont.) ; 03 Aug 98 9:36 PM
2 ;;5.3;Scheduling;**144**;AUG 13, 1993
3PLIST(C,SDLP,SDTEMP) ;Display parameter list
4 ;Required input: C=column to format left margin
5 ;Required input: SDLP=number of lines to print on a page
6 ;Optional input: SDTEMP=array of template information to print
7 N SDI,SDII,SDS1,SDS2,SDX,SDX1,SDX2,SDL S (SDOUT,SDL)=0
8 D PHD(" R E P O R T F O R M A T ") Q:SDOUT D D1("F","") Q:SDOUT
9 D PHD(" R E P O R T P E R S P E C T I V E ") Q:SDOUT D D2("Perspective","P",1) Q:SDOUT
10 D PHD(" R E P O R T L I M I T A T I O N S ") Q:SDOUT D D1("L",2) Q:SDOUT
11 S SDS1="L",SDS2=2 F S SDS2=$O(SDPAR(SDS1,SDS2)) Q:'SDS2!SDOUT D:SDL>SDLP WAIT Q:SDOUT W ! S SDL=SDL+1 D D2("Addl. limitation",SDS1,SDS2)
12 Q:SDOUT D PHD(" R E P O R T P R I N T O R D E R ") Q:SDOUT D D1("O","")
13 I $D(SDPAR("PF")) D PHD(" A D D I T I O N A L P R I N T F I E L D S ") Q:SDOUT
14 F SDS2=2,1 S SDS3=0 F S SDS3=$O(SDPAR("PF",SDS2,SDS3)) Q:'SDS3 S SDX=SDPAR("PF",SDS2,SDS3) D:SDL>SDLP WAIT Q:SDOUT W !?(C+36-$L($P(SDX,U,2))),$P(SDX,U,2),": ",$E($P(SDX,U,3),1,(42+C)) S SDL=SDL+1
15 Q:SDOUT D:SDL>SDLP WAIT Q:SDOUT D:$D(SDTEMP)>1 PHD(" T E M P L A T E I N F O R M A T I O N "),PTMP Q:SDOUT
16 D:SDL>SDLP WAIT Q:SDOUT W ! S SDL=SDL+1 D:SDL>SDLP WAIT Q:SDOUT W ! S SDL=SDL+1 F SDI=1:1:IOM W "-"
17 I $E(IOST)="C" D WAIT
18 Q
19 ;
20PTMP N SDI S SDI=0 F S SDI=$O(SDTEMP(SDI)) Q:'SDI!SDOUT S SDX=$P(SDTEMP(SDI),U),SDX1=$P(SDTEMP(SDI),U,2) D D2P
21 Q
22 ;
23D1(SDI,SDE) S SDII="" F S SDII=$O(SDPAR(SDI,SDII)) Q:SDII=""!(SDE&(SDII>SDE)) S SDX=$P($T(@SDI+SDII),";;",2) D:SDL>SDLP WAIT Q:SDOUT W !?(C+36-$L(SDX)),SDX,": ",$E($P(SDPAR(SDI,SDII),U,2),1,(42+C)) S SDL=SDL+1
24 Q
25 ;
26D2(SDTX,SDS1,SDS2) Q:'$D(SDPAR(SDS1,SDS2)) S SDX=SDTX_" category",SDX1=$P(SDPAR(SDS1,SDS2),U,2) D D2P Q:SDOUT
27 Q:'$D(SDPAR(SDS1,SDS2,1)) S SDX=SDTX_" sub-category",SDX1=$P(SDPAR(SDS1,SDS2,1),U,2) D D2P Q:SDOUT
28 Q:'$D(SDPAR(SDS1,SDS2,2)) S SDX2=$P(SDPAR(SDS1,SDS2,2),U) D:SDL>SDLP WAIT Q:SDOUT S SDX1=$O(SDPAR(SDS1,SDS2,4,"")) Q:SDX1=""
29 S SDX=$S(SDS1="P":"Detail",$P(SDPAR(SDS1,SDS2,3),U)="I":"Include",1:"Exclude")_" "_$S("LN"[SDX2:"list",1:"range - from") D D2P Q:SDOUT
30 I SDX2="R" S SDX="to",SDX1=$O(SDPAR(SDS1,SDS2,4,SDX1)) Q:SDX1="" D D2P Q
31 F S SDX1=$O(SDPAR(SDS1,SDS2,4,SDX1)) Q:SDX1=""!SDOUT D:SDL>SDLP WAIT Q:SDOUT W !?(38+C),SDX1 S SDL=SDL+1
32 Q
33 ;
34D2P D:SDL>SDLP WAIT Q:SDOUT W !?(C+36-$L(SDX)),SDX,": ",$E(SDX1,1,(42+C)) S SDL=SDL+1 Q
35 ;
36F ;Format captions
37 ;;Report output format
38 ;;Compare data to previous year
39 ;;Type of detail
40 ;;List activity detail by
41 ;;Limit Dx/Proc. list to most frequent
42 ;;Produce output as
43L ;Limitation captions
44 ;;Starting date
45 ;;Ending date
46O ;Order caption
47 ;;Output order
48 ;;Report descriptive title
49 ;
50XY(X) ;Maintain $X, $Y
51 ;Required input: X=screen handling variable to write
52 S:'$D(SDXY) SDXY=^%ZOSF("XY") N DX,DY S DX=$X,DY=$Y W X X SDXY Q ""
53 ;
54PHD(SDH) ;Parameter header
55 ;Required input: SDH=header value
56 W ! S SDL=SDL+1 D:(SDL+1)>SDLP WAIT Q:SDOUT
57 W ! S SDL=SDL+1
58 F W "-" Q:$X>(IOM-3-$L(SDH)\2)
59 W " ",SDH," " F W "-" Q:$X>(IOM-1)
60 W ! S SDL=SDL+1 D:SDL>SDLP WAIT Q
61 ;
62WAIT I $E(IOST)="C" N DIR S DIR(0)="E" D ^DIR S:'Y SDOUT=1 W:'SDOUT $$XY(IOELALL),$$XY(IOCUU) S SDL=0 Q
63 D HDR^SCRPW29("Report Parameters Selected") S SDL=0 Q
64 ;
65CAT(SDA) ;Enter edit perspective and limitation categories
66 ;Required entry: SDA="A" for add or "E" for edit
67 K SDPAR("X") M:SDA="E" SDPAR("X")=SDPAR(SDS1) I SDS1="L",SDA="E" S SDSEL=$P(SDPAR(SDS1,SDS2),U)_$P(SDPAR(SDS1,SDS2,1),U) G CAT1
68 S (SDSEL,SDX)=$$DIR^SCRPW23(.DIR,1,"","","O") Q:SDOUT!SDNUL
69 I SDA="E",SDX'=SDPAR(SDS1,SDS2) K SDPAR("X",SDS2)
70 S SDPAR("X",SDS2)=SDX
71 K SDEXE D PRMT("X",SDS2) S SDX=$$DIR^SCRPW23(.DIR,2,$G(SDEXE),$P(SDPAR("X",SDS2),U)) G:SDOUT!SDNUL CATQ
72 I SDA="E",SDX'=$G(SDPAR("X",SDS2,1)) D
73 .F SDI=1:1:6 K SDPAR("X",SDS2,SDI)
74 .F SDI=4,5,6 K SDPAR(SDS1,SDS2,SDI)
75 .Q
76 S SDPAR("X",SDS2,1)=SDX,SDSEL=$P(SDSEL,U)_$P(SDX,U)
77 I SDS1="P",$P(SDPAR("F",1),U)="S" M SDPAR(SDS1)=SDPAR("X") Q
78CAT1 S SDACT=^TMP("SCRPW",$J,"ACT",SDSEL)
79 I SDS1="P" S SDLR="L",SDX=$$RL() G:SDOUT CATQ S SDPAR("X",SDS2,2)=SDX D RL^SCRPW23 S (SDOUT,SDNUL)=0 M:$D(SDPAR("X",SDS2,4)) SDPAR(SDS1)=SDPAR("X") G:'$D(SDPAR("X",SDS2,4)) CATQ D CATD Q
80 S SDLR=$P(SDACT,T,5),SDX=$$RL() G:SDOUT CATQ I SDA="E",SDX'=SDPAR("X",SDS2,2) F SDI=4,5 K SDPAR("X",SDS2,SDI)
81 S SDPAR("X",SDS2,2)=SDX D RL^SCRPW23,CATD S (SDOUT,SDNUL)=0 G:'$D(SDPAR("X",SDS2,4)) CATQ
82 K DIR D DIRB("X",SDS2,3) S DIR(0)="S^I:INCLUDE;E:EXCLUDE",DIR("A")="Include or exclude records in this category" D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G CATQ
83 S SDPAR("X",SDS2,3)=Y_U_Y(0) M SDPAR(SDS1)=SDPAR("X") Q
84 ;
85CATD Q:'SDREV!($D(SDPAR(SDS1,SDS2,4)))!'$D(SDPAR(SDS1,SDS2))
86 W !!,$C(7),"Required ",$S($P(SDPAR(SDS1,SDS2,2),U)="L":"list",1:"range")," data missing.",!,$P(SDPAR(SDS1,SDS2),U,2),": ",$P(SDPAR(SDS1,SDS2,1),U,2)," element deleted!" H 3
87 K SDPAR(SDS1,SDS2) Q
88 ;
89CATQ W !!,"Required data missing! "_$S(SDS1="P":"Perspective ",1:"Limitation item ")_$S(SDA="E":"changes ",1:"")_"not filed.",! H 2 S (SDOUT,SDNUL)=0 Q
90 ;
91RL() ;List or range?
92 ;Output: selector type
93 K DIR D DIRB("X",SDS2,2)
94 S DIR("A")="Limit this factor by",DIR("?")="Specify if a list or a range of items should be used to limit this element.",DIR(0)="S^"_$S(SDLR["L":"L:LIST;",1:"")_$S(SDLR["R":"R:RANGE;",1:"")_"N:NULL (NO DATA VALUE)"
95 Q $$DIR^SCRPW23(.DIR,0)
96 ;
97PRMT(SDS1,SDS2) ;Prompts for level DIR2
98 ;Required input: SDS1,SDS2=subscript to find responses
99 K DIR(0) D DIRB("X",SDS2,1) S DIR("A")="Select "_$P(SDPAR(SDS1,SDS2),U,2)_" category" Q
100 ;
101DIRB(SDS1,SDS2,SDS3) ;Get default value
102 ;Required input: SDS1,SDS2,SDS3=subscript value
103 S DIR("B")=$P($G(SDPAR(SDS1,SDS2,SDS3)),U,2) K:'$L(DIR("B")) DIR("B") Q
104 ;
105AED(SDS1) ;Add/edit/delete element categories
106 ;Required input: SDS1=global subscript to work with
107 N SDOUT S SDOUT=0 F Q:SDOUT!SDNUL D AED1
108 Q
109 ;
110AED1 I '$O(SDPAR(SDS1,2)) D A Q
111 W !!?28,$$XY(IORVON)," Limitation item action ",$$XY(IORVOFF) K DIR S DIR(0)="SO^A:ADD CATEGORY ITEMS;E:EDIT CATEGORY ITEMS;D:DELETE CATEGORY ITEMS",DIR("A")="Select edit action"
112 D ^DIR I $D(DTOUT)!$D(DUOUT)!($G(X)="") S SDOUT=1 Q
113 D @Y Q
114 ;
115A ;Add items
116 D L2A^SCRPW20 Q
117 ;
118E ;Edit items
119 S SDX=$$ILIST("E") Q:'SDX!SDOUT S SDS2=+SDX D CAT("E") Q
120 ;
121D ;Delete items
122 S SDX=$$ILIST("D") Q:'SDX!SDOUT D DEL1 Q
123 ;
124DEL1 N DIR S DIR(0)="Y",DIR("A")="Ok to delete "_$P(SDX,U,2)_" item",DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
125 Q:'Y K SDPAR(SDS1,$P(SDX,U)) Q
126 ;
127ILIST(SDY) ;List/select items
128 ;Required input: SDY="E" for edit, "D" for delete
129 N SDI,SDX,SDOUT,SDS2 S (SDI,SDOUT)=0,SDS2=2,SDX=""
130 W ! F S SDS2=$O(SDPAR(SDS1,SDS2)) Q:'SDS2!SDOUT S SDI=SDI+1 D ISET W !,SDI,". ",$P(SDI(SDI),U,2) D:'SDI#5 IL1
131 D:'SDOUT&SDI#5 IL1 Q SDX
132 ;
133ISET S SDI(SDI)=SDS2_U_$P(SDPAR(SDS1,SDS2),U,2)_": "_$P(SDPAR(SDS1,SDS2,1),U,2)_" ("_$P(SDPAR(SDS1,SDS2,2),U,2)_")" Q
134 ;
135IL1 W ! N DIR S DIR(0)="NO^1:"_SDI_":0",DIR("A")="Select item to "_$S(SDY="E":"edit",1:"delete") D ^DIR W ! I $D(DTOUT)!$D(DUOUT)!$G(Y) S SDOUT=1
136 S SDX=$G(SDI(+$G(Y))) Q
137 ;
138DESC ;Prompt for descriptive report title
139 K DIR D DIRB1^SCRPW23("O",2)
140 S DIR(0)="FO^1:80",DIR("A")="Report descriptive title (optional)",DIR("?")="Enter brief text describing the report (displayed at top of each page printed)."
141 W ! S SDX=$$DIR^SCRPW23(.DIR,0) I SDX=""!(SDX=U) K SDPAR("O",2) Q
142 S:$L(SDX) SDPAR("O",2)=SDX Q
143 ;
144REST() ;Select/restore template for editing
145 ;Ouput: 1=template restored, 0=template not restored
146 Q:'$O(^SDD(409.91,0)) 0
147 W ! K DIR S DIR(0)="YO",DIR("A")="Would you like to use parameters from an existing template" D ^DIR I $D(DUOUT)!$D(DTOUT) S SDOUT=1 Q 0
148 Q:'Y 0 W ! K SDPAR Q $$SELT^SCRPW21(.SDPAR)
Note: See TracBrowser for help on using the repository browser.