| 1 | FHMASE1 ; 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 | ;
|
|---|
| 14 | IND ;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 | ;
|
|---|
| 24 | COM ; 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 | ;
|
|---|
| 30 | A0 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 | ;
|
|---|
| 33 | A1 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 | ;
|
|---|
| 35 | F0 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 | ;
|
|---|
| 38 | F1 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 | ;
|
|---|
| 41 | F2 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 | ;
|
|---|
| 46 | KIL ;
|
|---|
| 47 | K ^TMP($J) G KILL^XUSCLEAN Q
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | DT ; Get From/To Dates
|
|---|
| 51 | D1 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 | ;
|
|---|
| 54 | D2 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
|
|---|
| 58 | N2 ;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
|
|---|
| 65 | QUIT ;
|
|---|
| 66 | Q
|
|---|
