Routine: ADEKRP3

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

ADEKRP3.m