FHMASE1.m

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 ---FHMASE1   2322     printed  Mar 13, 2025@20:52:32                                                                                                                                                                                                     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