source: FOIAVistA/trunk/r/DIETETICS-FH/FHMASE1.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1FHMASE1 ; HISC/AAC - Multidivisional Encounter Statistics ;10/14/03 11:57
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4 ;Encounter Statistic
5 ;
6 S HEADER="S T A T I S T I C S"
7 S (Y,CO)=""
8 D COM
9 I (Y=-1)&(CO="") Q
10 D DT G:U[X KIL
11 D A0
12 Q
13 ;
14IND ;List Encounters
15 ;
16 S HEADER="V I S I T S "
17 S (Y,CO)=""
18 D COM
19 I (Y=-1)&(CO="") Q
20 D DT G:U[X KIL S FHX1=DUZ,FHX2=0
21 D F1
22 Q
23 ;
24COM ; List Encounters for a clinician
25 S (ZCO,CO,COXX,CONAME,CONAM)=""
26 R !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
27 I ZCO'="Y" D N2 Q
28 Q
29 ;
30A0 R !!,"Statistics for ALL Clinicians? Y// ",X:DTIME G:'$T!(X["^") KIL S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G A0
31 I X?1"Y".E G F0
32 ;
33A1 K DIC S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Select CLINICIAN: " W ! D ^DIC K DIC G KIL:"^"[X!$D(DTOUT),A1:Y<1 S FHX1=+Y,FHX2=1 G F1
34 ;
35F0 R !!,"Break-down by Clinician? Y// ",X:DTIME G:'$T!(X=U) KIL S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G F0
36 S FHX1=X?1"Y".E-1,FHX2=0
37 ;
38F1 I FHX1'<0 R !!,"List Individual Patient Encounters? N// ",X:DTIME G:'$T!(X=U) KIL S:X="" X="N" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G F1
39 S:FHX1'<0 FHX2=X?1"Y".E
40 ;
41F2 W !!,"The report requires a 132 column printer.",!
42 K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
43 I $D(IO("Q")) S FHPGM="Q1^FHMASE1A",FHLST="HEADER^EDT^SDT^FHX1^FHX2^ZCO^NAME^CONUMX^CO^CONAME" D EN2^FH Q
44 U IO D Q1^FHMASE1A D ^%ZISC K %ZIS,IOP G KIL
45 ;
46KIL ;
47 K ^TMP($J) G KILL^XUSCLEAN Q
48 Q
49 ;
50DT ; Get From/To Dates
51D1 S %DT="AEPX",%DT("A")="Starting Date: " W ! D ^%DT S:$D(DTOUT) X="^" Q:U[X G:Y<1 D1 S SDT=+Y
52 I SDT>DT W *7," [Cannot Start after Today!] " G D1
53 ;
54D2 S %DT="AEPX",%DT("A")=" Ending Date: " D ^%DT S:$D(DTOUT) X="^" Q:U[X G:Y<1 D2 S EDT=+Y
55 I EDT<SDT W *7," [End before Start?] " G D1
56 I EDT>DT W *7," [Must Not enter date greater than Today!] " G D1
57 Q
58N2 ;Get Communications Office
59 S DIC=119.73,DIC(0)="AEQ",DIC("A")="Select Communication Offices: "
60 D ^DIC I (Y=-1)&(CO="") Q
61 I Y=-1 Q
62 S CON=$P(Y,"^",1),CO=CON_"^"_CO,CONAM=$P(Y,"^",2),CONAME=CONAM_"^"_CONAME S CONUMX=$L(CO,"^") G N2
63 I Y=-1 K DIC Q
64 Q
65QUIT ;
66 Q
Note: See TracBrowser for help on using the repository browser.