- FHASE1 ; HISC/REL/NCA - Encounter Statistics ;3/6/95 11:57
- ;;5.5;DIETETICS;;Jan 28, 2005
- ; Check for multidivisional site
- I $P($G(^FH(119.9,1,0)),U,20)'="N" D ^FHMASE1 Q
- D DT G:U[X KIL G A0
- IND ; List Encounters for a clinician
- ; Check for multidivisional site
- I $P($G(^FH(119.9,1,0)),U,20)'="N" D IND^FHMASE1 Q
- D DT G:U[X KIL S FHX1=DUZ,FHX2=0 G F1
- 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 F2
- 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^FHASE1A",FHLST="EDT^SDT^FHX1^FHX2" D EN2^FH G KIL
- U IO D Q1^FHASE1A D ^%ZISC K %ZIS,IOP G KIL
- KIL K ^TMP($J) G KILL^XUSCLEAN
- 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
- FHASE1 ; HISC/REL/NCA - Encounter Statistics ;3/6/95 11:57
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- +2 ; Check for multidivisional site
- +3 IF $PIECE($GET(^FH(119.9,1,0)),U,20)'="N"
- DO ^FHMASE1
- QUIT
- +4 DO DT
- IF U[X
- GOTO KIL
- GOTO A0
- IND ; List Encounters for a clinician
- +1 ; Check for multidivisional site
- +2 IF $PIECE($GET(^FH(119.9,1,0)),U,20)'="N"
- DO IND^FHMASE1
- QUIT
- +3 DO DT
- IF U[X
- GOTO KIL
- SET FHX1=DUZ
- SET FHX2=0
- GOTO F1
- 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
- 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 F2
- 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
- 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
- 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^FHASE1A"
- SET FHLST="EDT^SDT^FHX1^FHX2"
- DO EN2^FH
- GOTO KIL
- +3 USE IO
- DO Q1^FHASE1A
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO KIL
- KIL KILL ^TMP($JOB)
- GOTO KILL^XUSCLEAN
- 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
- 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
