source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVRPPCD.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1WVRPPCD ;HCIOFO/FT,JR-REPORT: PROCEDURES STATISTICS; ;7/23/01 13:33
2 ;;1.0;WOMEN'S HEALTH;**12**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; CALLED BY OPTION: "WV PRINT PROCEDURE STATS".
6 ;
7 ; This routine uses the following IAs:
8 ; <NONE>
9 ;
10 N N,R,X,T,Y,R,PG,PA,JC,J,TR,TR2,JR,JR2,CM,CM2,WVJRC,FE,FI,WVSB
11 K ^TMP("WVRES",$J),^TMP("WVAR",$J),^TMP("WVNOHCF",$J)
12 S WVPOP=0 K WVRES
13 D TITLE^WVUTL5("PROCEDURE STATISTICS REPORT")
14 D DATES G:WVPOP EXIT
15 D SELECT G:WVPOP EXIT
16 D BYAGE(.WVAGRG,.WVPOP) G:WVPOP EXIT
17 D FAC G:WVPOP EXIT
18 D DEVICE G:WVPOP EXIT
19 D ^WVRPPCD2
20 D COPYGBL
21 D ^WVRPPCD1
22 ;
23EXIT ;EP
24 K ^TMP("WVRES",$J),^TMP("WVAR",$J),^TMP("WVNOHCF",$J)
25 D KILLALL^WVUTL8
26 Q
27 ;
28DATES ;EP
29 ;---> ASK DATE RANGE. RETURN DATES IN WVBEGDT AND WVENDDT.
30 D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-365","T")
31 Q
32 ;
33SELECT ;EP
34 D SELECT^WVSELECT("Procedure Type",790.2,"WVARR","","",.WVPOP)
35 Q
36 ;
37BYAGE(WVAGRG,WVPOP) ;EP
38 ;---> RETURN AGE RANGE IN WVAGRG.
39 N DIR,DIRUT,Y S WVPOP=0
40 W !!?3,"Do you wish to display statistics by age group?"
41 S DIR(0)="Y",DIR("B")="YES" D HELP1
42 S DIR("A")=" Enter Yes or No"
43 D ^DIR K DIR W !
44 S:$D(DIRUT) WVPOP=1
45 ;---> IF NOT DISPLAYING BY AGE GROUP, SET WVAGRG (AGE RANGE)=1, QUIT.
46 I 'Y S WVAGRG=1 Q
47BYAGE1 ;
48 W !?5,"Enter the age ranges you wish to select for in the form of:"
49 W !?5," 15-29,30-39,40-105"
50 W !?5,"Use a dash ""-"" to separate the limits of a range,"
51 W !?5,"use a comma to separate the different ranges."
52 W !!?5,"NOTE: Patient ages will reflect the age they were on the"
53 W !?5," dates of their procedures. Patient ages will NOT"
54 W !?5," necessarily be their ages today.",!
55 K DIR D HELP2
56 S DIR(0)="FOA",DIR("A")=" Enter age ranges: "
57 S:$D(^WV(790.72,DUZ,0)) DIR("B")=$P(^(0),U,2)
58 D ^DIR K DIR
59 I $D(DIRUT) S WVPOP=1 Q
60 D CHECK(.Y)
61 I Y="" D G BYAGE1
62 .W !!?5,"* INVALID AGE RANGE. Please begin again. (Enter ? for help.)"
63 ;---> WVAGRG=SELECTED AGE RANGE(S).
64 S WVAGRG=Y
65 D DIC^WVFMAN(790.72,"L",.Y,"","","","`"_DUZ)
66 Q:Y<0
67 D DIE^WVFMAN(790.72,".02////"_WVAGRG,+Y,.WVPOP,1)
68 Q
69 ;
70FAC ; Select one or more facilities
71 D SELECT^WVSELECT("Facility",790.02,"WVSB","",DUZ(2),.WVPOP)
72 Q
73DEVICE ;EP
74 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
75 S ZTDESC="Procedure Statistics Report"
76 S ZTRTN="DEQUEUE^WVRPPCD"
77 F WVSV="AGRG","BEGDT","ENDDT" D
78 .I $D(@("WV"_WVSV)) S ZTSAVE("WV"_WVSV)=""
79 ;---> SAVE PROCEDURES ARRAY.
80 I $D(WVARR) N N S N=0 F S N=$O(WVARR(N)) Q:N="" D
81 .S ZTSAVE("WVARR("""_N_""")")=""
82 ; Save Facility array
83 I $D(WVSB) N N S N=0 F S N=$O(WVSB(N)) Q:N="" D
84 .S ZTSAVE("WVSB("""_N_""")")=""
85 .Q
86 D ZIS^WVUTL2(.WVPOP,1)
87 Q
88 ;
89COPYGBL ;EP
90 ;---> COPY ^TMP("WVRES",$J,"R") TO ^TMP("WVAR",$J, TO MAKE IT FLAT.
91 N FE,FI,I,M,N K WVAR
92 S I=0,FE=""
93 F S FE=$O(^TMP("WVRES",$J,"R",FE)) Q:FE="" S FI=0 F S FI=$O(^TMP("WVRES",$J,"R",FE,FI)) Q:'FI S N=0 F S N=$O(^TMP("WVRES",$J,"R",FE,FI,N)) Q:N="" D
94 .S M=0
95 .F S M=$O(^TMP("WVRES",$J,"R",FE,FI,N,M)) Q:M="" D
96 ..S I=I+1,^TMP("WVAR",$J,FE,FI,I)=^TMP("WVRES",$J,"R",FE,FI,N,M)
97 Q
98 ;
99DEQUEUE ;EP
100 ;---> TASKMAN QUEUE OF PRINTOUT.
101 D SETVARS^WVUTL5,^WVRPPCD2
102 I $G(ZTSTOP)=1 D EXIT Q ;user requested the job to stop
103 D COPYGBL,^WVRPPCD1,EXIT
104 Q
105 ;
106HELP1 ;EP
107 ;;Answer "YES" to display statistics by age group. If you choose
108 ;;to display by age group, you will be given the opportunity to
109 ;;select the age ranges. For example, you might choose to display
110 ;;from ages 15-40,41-65,65-99.
111 ;;Answer "NO" to display statistics without grouping by age.
112 S WVTAB=5,WVLINL="HELP1" D HELPTX
113 Q
114 ;
115HELP2 ;EP
116 ;;Enter each age range you wish to report on by entering the
117 ;;earlier age-dash-older age. For example, 20-29 would report
118 ;;on all patients between the ages of 20 and 29 inclusive.
119 ;;You may select as many age ranges as you wish. Age ranges must
120 ;;be separated by commas. For example: 15-19,20-29,30-39
121 ;;To select only one age, simply enter that age, with no dashes,
122 ;;for example, 30 would report only on women who were 30 years
123 ;;of age.
124 S WVTAB=5,WVLINL="HELP2" D HELPTX
125 Q
126 ;
127HELPTX ;EP
128 ;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
129 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
130 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
131 S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
132 Q
133 ;
134CHECK(X) ;EP
135 ;---> CHECK SYNTAX OF AGE RANGE STRING.
136 ;---> IF X=ONE AGE ONLY, SET IT IN THE FORM X-X AND QUIT.
137 I X?1N.N S X=X_"-"_X Q
138 ;
139 N WV1,FAIL,I,Y,Y1,Y2
140 S FAIL=0
141 ;---> CHECK EACH RANGE.
142 F I=1:1:$L(X,",") S Y=$P(X,",",I) D Q:FAIL
143 .S Y1=$P(Y,"-"),Y2=$P(Y,"-",2)
144 .;---> EACH END OF EACH RANGE SHOULD BE A NUMBER.
145 .I (Y1'?1N.N)!(Y2'?1N.N) S FAIL=1 Q
146 .;---> THE LOWER NUMBER SHOULD BE FIRST.
147 .I Y2<Y1 S FAIL=1
148 I FAIL S X="" Q
149 ;
150 ;---> MAKE SURE ORDER IS FROM LOWEST (YOUNGEST) TO HIGHEST (OLDEST).
151 F I=1:1:$L(X,",") S Y=$P(X,",",I),Y1=$P(Y,"-"),WV1(Y1)=Y
152 S N=0,X=""
153 F S N=$O(WV1(N)) Q:'N S X=X_WV1(N)_","
154 S:$E(X,$L(X))="," X=$E(X,1,($L(X)-1))
155 Q
Note: See TracBrowser for help on using the repository browser.