ADEKRP3 ; IHS/HQT/MJL - PRINT COMPILED REPORTS ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
;
ASKYQ() ;EP
;Asks to select YEAR and QUARTER
;Returns YYYY.Q
;limits selection to periods for which objectives data
;has been compiled in ^ADEKNT
;Returns 0 if no valid selection made
;
N ADEMO,ADEYQ,ADESET,ADECNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT
;
S ADEYQ=0
F S ADEYQ=$O(^ADEKNT("AD",ADEYQ)) Q:ADEYQ="" D
. S ADEYQ=$P(ADEYQ,".",1,2)
. S ADEYQ(ADEYQ)=""
. S $P(ADEYQ,".",3)=99999
;
I '$O(ADEYQ(0)) Q "NO DATA"
;
S ADEYQ=0,ADESET="",ADECNT=0
F S ADEYQ=$O(ADEYQ(ADEYQ)) Q:ADEYQ="" S ADECNT=ADECNT+1 D
. S ADEMO=$S($P(ADEYQ,".",2)=1:" (JAN-MAR "_$P(ADEYQ,".")_")",$P(ADEYQ,".",2)=2:" (APR-JUN "_$P(ADEYQ,".")_")",$P(ADEYQ,".",2)=3:" (JUL-SEP "_$P(ADEYQ,".")_")",1:" (OCT-DEC "_$P(ADEYQ,".")_")")
. I ADECNT=1 S ADESET=ADECNT_":"_ADEYQ_ADEMO Q
. S $P(ADESET,";",ADECNT)=ADECNT_":"_ADEYQ_ADEMO
;
S DIR(0)="S^"_ADESET
S DIR("A")="Select YEAR.QUARTER"
S DIR("A",1)="Select the calendar year and quarter for the report."
S DIR("A",2)="Statistics have been compiled for the quarters listed above."
S DIR("A",3)=" "
S DIR("B")=$O(ADEYQ(999999),-1)
D ^DIR
I $$HAT^ADEPQA Q 0
Q $P(Y(0)," ")
;
ROPT() ;EP
;Asks user for report options
;Returns options in ^-delimited string of Template names;Header
;If timeout, hatout or none selected, returns null
;
N ADESET,ADECNT,ADEDHD,ADEQTR,ADEYR,ADEMON,ADERCNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT,ADEFLDS,ADETMP,J
S ADESET="1: 437 QUARTERLY DETAIL;2: 437 QUARTERLY COMBINED;3: 437 ANNUAL DETAIL;4: 437 ANNUAL COMBINED;5: ANNUAL BASIC MEASURES;6: QUARTERLY BASIC MEASURES;A: ALL REPORTS"
S ADERCNT=$L(ADESET,";")
S DIR("A")="Select REPORT"
S DIR("A",1)="Enter the number of a report which you wish to view."
S DIR("A",2)="Reports that you select will be marked with an asterisk."
S DIR("A",3)="Press RETURN to quit selecting reports."
F D Q:$$HAT^ADEPQA Q:X=""
. S DIR(0)="SOX^"_ADESET
. D ^XBCLS,^DIR
. Q:$$HAT^ADEPQA
. Q:X=""
. S ADESET=$$TOGGLE(ADESET,Y)
. Q
;
S ADEQTR=$P(ADEYQ,".",2),ADEYR=$P(ADEYQ,".")
;beginning Y2K fix
;S ADEYR=$S(ADEYR>80:"19"_ADEYR,1:"20"_ADEYR)
;end Y2K fix block
S ADEMON="MARCH^JUNE^SEPTEMBER^DECEMBER"
S ADEDHD=$O(^ADEPARAM(0)),ADEDHD=$P(^ADEPARAM(ADEDHD,0),U),ADEDHD=$P(^DIC(4,ADEDHD,0),U)
S ADETMP="[ADEK-SINGLE-QUARTER];"_ADEDHD_" DETAILED OBJECTIVES FOR QUARTER "_ADEQTR_", YEAR "_ADEYR
S ADETMP=ADETMP_"^[ADEK-COMBINE-QUARTER];"_ADEDHD_" COMBINED OBJECTIVES FOR QUARTER "_ADEQTR_", YEAR "_ADEYR
S ADETMP=ADETMP_"^[ADEK-SINGLE-YEAR];"_ADEDHD_" DETAILED OBJECTIVES FOR YEAR ENDING "_$P(ADEMON,U,ADEQTR)_" "_ADEYR
S ADETMP=ADETMP_"^[ADEK-COMBINE-YEAR];"_ADEDHD_" COMBINED OBJECTIVES FOR YEAR ENDING "_$P(ADEMON,U,ADEQTR)_" "_ADEYR
S ADETMP=ADETMP_"^[ADEK-CALIF];"_ADEDHD_" ANNUAL DENTAL BASIC MEASURES FOR YEAR ENDING "_$P(ADEMON,U,ADEQTR)_" "_ADEYR
S ADETMP=ADETMP_"^[ADEK-CALIFQ];"_ADEDHD_" QUARTERLY DENTAL BASIC MEASURES FOR QUARTER "_ADEQTR_", YEAR "_ADEYR
S ADEFLDS="",ADECNT=0
F J=1:1:ADERCNT I $P(ADESET,";",J)["*" D
. S ADECNT=ADECNT+1
. I ADECNT=1 S ADEFLDS=$P(ADETMP,U,J)
. E S $P(ADEFLDS,U,ADECNT)=$P(ADETMP,U,J)
Q ADEFLDS
;
TOGGLE(ADESET,Y) ;EP
;
N J,ADEOPT
I Y="A" D S $P(ADESET,";",ADERCNT)="N: NO REPORTS" Q ADESET
. F J=1:1:ADERCNT D
. . S ADEOPT=$P(ADESET,";",J)
. . S ADEOPT=$P(ADEOPT,":",2)
. . S:ADEOPT'["*" $E(ADEOPT,1,1)="*"
. . S $P(ADESET,";",J)=J_":"_ADEOPT
. . Q
. Q
I Y="N" D S $P(ADESET,";",ADERCNT)="A: ALL REPORTS" Q ADESET
. F J=1:1:ADERCNT D
. . S ADEOPT=$P(ADESET,";",J)
. . S ADEOPT=$P(ADEOPT,":",2)
. . I ADEOPT["*" S $E(ADEOPT,1,1)=" "
. . S $P(ADESET,";",J)=J_":"_ADEOPT
. . Q
. Q
;
S ADEOPT=$P(ADESET,";",Y)
S ADEOPT=$P(ADEOPT,":",2)
I ADEOPT["*" S $E(ADEOPT,1,1)=" "
E S $E(ADEOPT,1,1)="*"
S $P(ADESET,";",Y)=Y_":"_ADEOPT
Q ADESET
ADEKRP3 ; IHS/HQT/MJL - PRINT COMPILED REPORTS ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 ;
ASKYQ() ;EP
+1 ;Asks to select YEAR and QUARTER
+2 ;Returns YYYY.Q
+3 ;limits selection to periods for which objectives data
+4 ;has been compiled in ^ADEKNT
+5 ;Returns 0 if no valid selection made
+6 ;
+7 NEW ADEMO,ADEYQ,ADESET,ADECNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+8 ;
+9 SET ADEYQ=0
+10 FOR
SET ADEYQ=$ORDER(^ADEKNT("AD",ADEYQ))
IF ADEYQ=""
QUIT
Begin DoDot:1
+11 SET ADEYQ=$PIECE(ADEYQ,".",1,2)
+12 SET ADEYQ(ADEYQ)=""
+13 SET $PIECE(ADEYQ,".",3)=99999
End DoDot:1
+14 ;
+15 IF '$ORDER(ADEYQ(0))
QUIT "NO DATA"
+16 ;
+17 SET ADEYQ=0
SET ADESET=""
SET ADECNT=0
+18 FOR
SET ADEYQ=$ORDER(ADEYQ(ADEYQ))
IF ADEYQ=""
QUIT
SET ADECNT=ADECNT+1
Begin DoDot:1
+19 SET ADEMO=$SELECT($PIECE(ADEYQ,".",2)=1:" (JAN-MAR "_$PIECE(ADEYQ,".")_")",$PIECE(ADEYQ,".",2)=2:" (APR-JUN "_$PIECE(ADEYQ,".")_")",$PIECE(ADEYQ,".",2)=3:" (JUL-SEP "_$PIECE(ADEYQ,".")_")",1:" (OCT-DEC "_$PIECE(ADEYQ,".")_")")
+20 IF ADECNT=1
SET ADESET=ADECNT_":"_ADEYQ_ADEMO
QUIT
+21 SET $PIECE(ADESET,";",ADECNT)=ADECNT_":"_ADEYQ_ADEMO
End DoDot:1
+22 ;
+23 SET DIR(0)="S^"_ADESET
+24 SET DIR("A")="Select YEAR.QUARTER"
+25 SET DIR("A",1)="Select the calendar year and quarter for the report."
+26 SET DIR("A",2)="Statistics have been compiled for the quarters listed above."
+27 SET DIR("A",3)=" "
+28 SET DIR("B")=$ORDER(ADEYQ(999999),-1)
+29 DO ^DIR
+30 IF $$HAT^ADEPQA
QUIT 0
+31 QUIT $PIECE(Y(0)," ")
+32 ;
ROPT() ;EP
+1 ;Asks user for report options
+2 ;Returns options in ^-delimited string of Template names;Header
+3 ;If timeout, hatout or none selected, returns null
+4 ;
+5 NEW ADESET,ADECNT,ADEDHD,ADEQTR,ADEYR,ADEMON,ADERCNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT,ADEFLDS,ADETMP,J
+6 SET ADESET="1: 437 QUARTERLY DETAIL;2: 437 QUARTERLY COMBINED;3: 437 ANNUAL DETAIL;4: 437 ANNUAL COMBINED;5: ANNUAL BASIC MEASURES;6: QUARTERLY BASIC MEASURES;A: ALL REPORTS"
+7 SET ADERCNT=$LENGTH(ADESET,";")
+8 SET DIR("A")="Select REPORT"
+9 SET DIR("A",1)="Enter the number of a report which you wish to view."
+10 SET DIR("A",2)="Reports that you select will be marked with an asterisk."
+11 SET DIR("A",3)="Press RETURN to quit selecting reports."
+12 FOR
Begin DoDot:1
+13 SET DIR(0)="SOX^"_ADESET
+14 DO ^XBCLS
DO ^DIR
+15 IF $$HAT^ADEPQA
QUIT
+16 IF X=""
QUIT
+17 SET ADESET=$$TOGGLE(ADESET,Y)
+18 QUIT
End DoDot:1
IF $$HAT^ADEPQA
QUIT
IF X=""
QUIT
+19 ;
+20 SET ADEQTR=$PIECE(ADEYQ,".",2)
SET ADEYR=$PIECE(ADEYQ,".")
+21 ;beginning Y2K fix
+22 ;S ADEYR=$S(ADEYR>80:"19"_ADEYR,1:"20"_ADEYR)
+23 ;end Y2K fix block
+24 SET ADEMON="MARCH^JUNE^SEPTEMBER^DECEMBER"
+25 SET ADEDHD=$ORDER(^ADEPARAM(0))
SET ADEDHD=$PIECE(^ADEPARAM(ADEDHD,0),U)
SET ADEDHD=$PIECE(^DIC(4,ADEDHD,0),U)
+26 SET ADETMP="[ADEK-SINGLE-QUARTER];"_ADEDHD_" DETAILED OBJECTIVES FOR QUARTER "_ADEQTR_", YEAR "_ADEYR
+27 SET ADETMP=ADETMP_"^[ADEK-COMBINE-QUARTER];"_ADEDHD_" COMBINED OBJECTIVES FOR QUARTER "_ADEQTR_", YEAR "_ADEYR
+28 SET ADETMP=ADETMP_"^[ADEK-SINGLE-YEAR];"_ADEDHD_" DETAILED OBJECTIVES FOR YEAR ENDING "_$PIECE(ADEMON,U,ADEQTR)_" "_ADEYR
+29 SET ADETMP=ADETMP_"^[ADEK-COMBINE-YEAR];"_ADEDHD_" COMBINED OBJECTIVES FOR YEAR ENDING "_$PIECE(ADEMON,U,ADEQTR)_" "_ADEYR
+30 SET ADETMP=ADETMP_"^[ADEK-CALIF];"_ADEDHD_" ANNUAL DENTAL BASIC MEASURES FOR YEAR ENDING "_$PIECE(ADEMON,U,ADEQTR)_" "_ADEYR
+31 SET ADETMP=ADETMP_"^[ADEK-CALIFQ];"_ADEDHD_" QUARTERLY DENTAL BASIC MEASURES FOR QUARTER "_ADEQTR_", YEAR "_ADEYR
+32 SET ADEFLDS=""
SET ADECNT=0
+33 FOR J=1:1:ADERCNT
IF $PIECE(ADESET,";",J)["*"
Begin DoDot:1
+34 SET ADECNT=ADECNT+1
+35 IF ADECNT=1
SET ADEFLDS=$PIECE(ADETMP,U,J)
+36 IF '$TEST
SET $PIECE(ADEFLDS,U,ADECNT)=$PIECE(ADETMP,U,J)
End DoDot:1
+37 QUIT ADEFLDS
+38 ;
TOGGLE(ADESET,Y) ;EP
+1 ;
+2 NEW J,ADEOPT
+3 IF Y="A"
Begin DoDot:1
+4 FOR J=1:1:ADERCNT
Begin DoDot:2
+5 SET ADEOPT=$PIECE(ADESET,";",J)
+6 SET ADEOPT=$PIECE(ADEOPT,":",2)
+7 IF ADEOPT'["*"
SET $EXTRACT(ADEOPT,1,1)="*"
+8 SET $PIECE(ADESET,";",J)=J_":"_ADEOPT
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
SET $PIECE(ADESET,";",ADERCNT)="N: NO REPORTS"
QUIT ADESET
+11 IF Y="N"
Begin DoDot:1
+12 FOR J=1:1:ADERCNT
Begin DoDot:2
+13 SET ADEOPT=$PIECE(ADESET,";",J)
+14 SET ADEOPT=$PIECE(ADEOPT,":",2)
+15 IF ADEOPT["*"
SET $EXTRACT(ADEOPT,1,1)=" "
+16 SET $PIECE(ADESET,";",J)=J_":"_ADEOPT
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
SET $PIECE(ADESET,";",ADERCNT)="A: ALL REPORTS"
QUIT ADESET
+19 ;
+20 SET ADEOPT=$PIECE(ADESET,";",Y)
+21 SET ADEOPT=$PIECE(ADEOPT,":",2)
+22 IF ADEOPT["*"
SET $EXTRACT(ADEOPT,1,1)=" "
+23 IF '$TEST
SET $EXTRACT(ADEOPT,1,1)="*"
+24 SET $PIECE(ADESET,";",Y)=Y_":"_ADEOPT
+25 QUIT ADESET
