FHMASE1 ; HISC/AAC - Multidivisional Encounter Statistics ;10/14/03 11:57
;;5.5;DIETETICS;;Jan 28, 2005
;
;Encounter Statistic
;
S HEADER="S T A T I S T I C S"
S (Y,CO)=""
D COM
I (Y=-1)&(CO="") Q
D DT G:U[X KIL
D A0
Q
;
IND ;List Encounters
;
S HEADER="V I S I T S "
S (Y,CO)=""
D COM
I (Y=-1)&(CO="") Q
D DT G:U[X KIL S FHX1=DUZ,FHX2=0
D F1
Q
;
COM ; List Encounters for a clinician
S (ZCO,CO,COXX,CONAME,CONAM)=""
R !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
I ZCO'="Y" D N2 Q
Q
;
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
I X?1"Y".E G F0
;
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
;
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
S FHX1=X?1"Y".E-1,FHX2=0
;
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
S:FHX1'<0 FHX2=X?1"Y".E
;
F2 W !!,"The report requires a 132 column printer.",!
K IOP,%ZIS S %ZIS("A")="Print on Device: ",%ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KIL
I $D(IO("Q")) S FHPGM="Q1^FHMASE1A",FHLST="HEADER^EDT^SDT^FHX1^FHX2^ZCO^NAME^CONUMX^CO^CONAME" D EN2^FH Q
U IO D Q1^FHMASE1A D ^%ZISC K %ZIS,IOP G KIL
;
KIL ;
K ^TMP($J) G KILL^XUSCLEAN Q
Q
;
DT ; Get From/To Dates
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
I SDT>DT W *7," [Cannot Start after Today!] " G D1
;
D2 S %DT="AEPX",%DT("A")=" Ending Date: " D ^%DT S:$D(DTOUT) X="^" Q:U[X G:Y<1 D2 S EDT=+Y
I EDT<SDT W *7," [End before Start?] " G D1
I EDT>DT W *7," [Must Not enter date greater than Today!] " G D1
Q
N2 ;Get Communications Office
S DIC=119.73,DIC(0)="AEQ",DIC("A")="Select Communication Offices: "
D ^DIC I (Y=-1)&(CO="") Q
I Y=-1 Q
S CON=$P(Y,"^",1),CO=CON_"^"_CO,CONAM=$P(Y,"^",2),CONAME=CONAM_"^"_CONAME S CONUMX=$L(CO,"^") G N2
I Y=-1 K DIC Q
Q
QUIT ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHMASE1 2322 printed Sep 23, 2025@19:23:52 Page 2
FHMASE1 ; HISC/AAC - Multidivisional Encounter Statistics ;10/14/03 11:57
+1 ;;5.5;DIETETICS;;Jan 28, 2005
+2 ;
+3 ;Encounter Statistic
+4 ;
+5 SET HEADER="S T A T I S T I C S"
+6 SET (Y,CO)=""
+7 DO COM
+8 IF (Y=-1)&(CO="")
QUIT
+9 DO DT
if U[X
GOTO KIL
+10 DO A0
+11 QUIT
+12 ;
IND ;List Encounters
+1 ;
+2 SET HEADER="V I S I T S "
+3 SET (Y,CO)=""
+4 DO COM
+5 IF (Y=-1)&(CO="")
QUIT
+6 DO DT
if U[X
GOTO KIL
SET FHX1=DUZ
SET FHX2=0
+7 DO F1
+8 QUIT
+9 ;
COM ; List Encounters for a clinician
+1 SET (ZCO,CO,COXX,CONAME,CONAM)=""
+2 READ !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME
WRITE !
SET ZCO=$TRANSLATE(ZCO,"y","Y")
+3 IF ZCO'="Y"
DO N2
QUIT
+4 QUIT
+5 ;
A0 READ !!,"Statistics for ALL Clinicians? Y// ",X:DTIME
if '$TEST!(X["^")
GOTO KIL
if X=""
SET X="Y"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO A0
+1 IF X?1"Y".E
GOTO F0
+2 ;
A1 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="AEQM"
SET DIC("A")="Select CLINICIAN: "
WRITE !
DO ^DIC
KILL DIC
if "^"[X!$DATA(DTOUT)
GOTO KIL
if Y<1
GOTO A1
SET FHX1=+Y
SET FHX2=1
GOTO F1
+1 ;
F0 READ !!,"Break-down by Clinician? Y// ",X:DTIME
if '$TEST!(X=U)
GOTO KIL
if X=""
SET X="Y"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO F0
+1 SET FHX1=X?1"Y".E-1
SET FHX2=0
+2 ;
F1 IF FHX1'<0
READ !!,"List Individual Patient Encounters? N// ",X:DTIME
if '$TEST!(X=U)
GOTO KIL
if X=""
SET X="N"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO F1
+1 if FHX1'<0
SET FHX2=X?1"Y".E
+2 ;
F2 WRITE !!,"The report requires a 132 column printer.",!
+1 KILL IOP,%ZIS
SET %ZIS("A")="Print on Device: "
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO KIL
+2 IF $DATA(IO("Q"))
SET FHPGM="Q1^FHMASE1A"
SET FHLST="HEADER^EDT^SDT^FHX1^FHX2^ZCO^NAME^CONUMX^CO^CONAME"
DO EN2^FH
QUIT
+3 USE IO
DO Q1^FHMASE1A
DO ^%ZISC
KILL %ZIS,IOP
GOTO KIL
+4 ;
KIL ;
+1 KILL ^TMP($JOB)
GOTO KILL^XUSCLEAN
QUIT
+2 QUIT
+3 ;
DT ; Get From/To Dates
D1 SET %DT="AEPX"
SET %DT("A")="Starting Date: "
WRITE !
DO ^%DT
if $DATA(DTOUT)
SET X="^"
if U[X
QUIT
if Y<1
GOTO D1
SET SDT=+Y
+1 IF SDT>DT
WRITE *7," [Cannot Start after Today!] "
GOTO D1
+2 ;
D2 SET %DT="AEPX"
SET %DT("A")=" Ending Date: "
DO ^%DT
if $DATA(DTOUT)
SET X="^"
if U[X
QUIT
if Y<1
GOTO D2
SET EDT=+Y
+1 IF EDT<SDT
WRITE *7," [End before Start?] "
GOTO D1
+2 IF EDT>DT
WRITE *7," [Must Not enter date greater than Today!] "
GOTO D1
+3 QUIT
N2 ;Get Communications Office
+1 SET DIC=119.73
SET DIC(0)="AEQ"
SET DIC("A")="Select Communication Offices: "
+2 DO ^DIC
IF (Y=-1)&(CO="")
QUIT
+3 IF Y=-1
QUIT
+4 SET CON=$PIECE(Y,"^",1)
SET CO=CON_"^"_CO
SET CONAM=$PIECE(Y,"^",2)
SET CONAME=CONAM_"^"_CONAME
SET CONUMX=$LENGTH(CO,"^")
GOTO N2
+5 IF Y=-1
KILL DIC
QUIT
+6 QUIT
QUIT ;
+1 QUIT
