ADEKNT61.m

ADEKNT61 ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;

ASKFY() ;EP

 ;Displays FY periods for which objectives data

 ;have already been compiled in ^ADEKNT

 ;Asks for FISCAL YEAR YYYY

 ;Default is most recent FY

 ;Returns YYYY.Q where Q is always 3

 ;Returns 0 if no valid YYYY entered or hatout

 ;

 N ADEY,ADEQ,ADEYQ,ADESET,ADECNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT

 ;

 S ADEYQ=0

 F  S ADEYQ=$O(^ADEKNT("AD",ADEYQ)) Q:ADEYQ=""  D

 . Q:$P(ADEYQ,".",2)'=3

 . S ADEYQ=$P(ADEYQ,".",1,2)

 . S ADEYQ(ADEYQ)=""

 . S $P(ADEYQ,".",3)=99999

 ;

DIR ;

 ;beginning Y2K fix

 ;S DIR(0)="F^2:4"

 S DIR(0)="F^4:4"

 ;end Y2K fix block

 S DIR("A")="Select FISCAL YEAR"

 S DIR("A",1)="A mail message may be created containing dental statistics"

 S DIR("A",2)="for one of the Fiscal years listed above."

 ;beginning Y2K fix

 ;S DIR("?")="Enter the Fiscal Year (or '^' to exit)"

 S DIR("?")="Enter the Fiscal Year as YYYY (or '^' to exit)"  ;Y2000

 ;end Y2K fix block

 I '$O(ADEYQ(0)) W !,"No prior Fiscal year statistics are on file on this computer." Q 0

 E   S ADEYQ=0 W !!!,"Statistics have been compiled for the following Fiscal years:" F  S ADEYQ=$O(ADEYQ(ADEYQ)) Q:'ADEYQ  D

 . W !,?5,$P(ADEYQ,".")

 D ^DIR

 I $$HAT^ADEPQA Q 0

 ;beginning Y2K fix

 ;I X'?1.4N W *7," ??" G DIR

 I X'?4N W *7," "_DIR("?") G DIR  ;Y2000

 ;S ADEY=$P(X,".")

 ;I $L(ADEY)>2 S ADEY=$E(ADEY,$L(ADEY)-1,$L(ADEY))

 ;I ADEY<80 W *7,!," Must be 1980 or later." G DIR

 S ADEY=X

 I ADEY<1980 W *7,!," Must be 1980 or later." G DIR  ;Y2000

 ;end Y2K fix block

 S ADEQ=3

 I ADEY_"."_ADEQ>$$QTR^ADEKNT5(DT) W *7,!," You must select a prior Fiscal year." G DIR

 S ADEYQ=ADEY_".3"

 I '$D(ADEYQ(ADEYQ)) W !,"No statistics for FY"_ADEY_" have been compiled on this computer. " G DIR

 Q ADEYQ

ADEKNT61  ; IHS/HQT/MJL - COMPILE DENTAL REPORTS ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;

ASKFY()   ;EP

 +1       ;Displays FY periods for which objectives data

 +2       ;have already been compiled in ^ADEKNT

 +3       ;Asks for FISCAL YEAR YYYY

 +4       ;Default is most recent FY

 +5       ;Returns YYYY.Q where Q is always 3

 +6       ;Returns 0 if no valid YYYY entered or hatout

 +7       ;

 +8        NEW ADEY,ADEQ,ADEYQ,ADESET,ADECNT,DIR,DTOUT,DUOUT,DIRUT,DIROUT

 +9       ;

 +10       SET ADEYQ=0

 +11       FOR 

               SET ADEYQ=$ORDER(^ADEKNT("AD",ADEYQ))

               IF ADEYQ=""

                   QUIT 

               Begin DoDot:1

 +12               IF $PIECE(ADEYQ,".",2)'=3

                       QUIT 

 +13               SET ADEYQ=$PIECE(ADEYQ,".",1,2)

 +14               SET ADEYQ(ADEYQ)=""

 +15               SET $PIECE(ADEYQ,".",3)=99999

               End DoDot:1

 +16      ;

DIR       ;

 +1       ;beginning Y2K fix

 +2       ;S DIR(0)="F^2:4"

 +3        SET DIR(0)="F^4:4"

 +4       ;end Y2K fix block

 +5        SET DIR("A")="Select FISCAL YEAR"

 +6        SET DIR("A",1)="A mail message may be created containing dental statistics"

 +7        SET DIR("A",2)="for one of the Fiscal years listed above."

 +8       ;beginning Y2K fix

 +9       ;S DIR("?")="Enter the Fiscal Year (or '^' to exit)"

 +10      ;Y2000

           SET DIR("?")="Enter the Fiscal Year as YYYY (or '^' to exit)"

 +11      ;end Y2K fix block

 +12       IF '$ORDER(ADEYQ(0))

               WRITE !,"No prior Fiscal year statistics are on file on this computer."

               QUIT 0

 +13      IF '$TEST

               SET ADEYQ=0

               WRITE !!!,"Statistics have been compiled for the following Fiscal years:"

               FOR 

                   SET ADEYQ=$ORDER(ADEYQ(ADEYQ))

                   IF 'ADEYQ

                       QUIT 

                   Begin DoDot:1

 +14                   WRITE !,?5,$PIECE(ADEYQ,".")

                   End DoDot:1

 +15       DO ^DIR

 +16       IF $$HAT^ADEPQA

               QUIT 0

 +17      ;beginning Y2K fix

 +18      ;I X'?1.4N W *7," ??" G DIR

 +19      ;Y2000

           IF X'?4N

               WRITE *7," "_DIR("?")

               GOTO DIR

 +20      ;S ADEY=$P(X,".")

 +21      ;I $L(ADEY)>2 S ADEY=$E(ADEY,$L(ADEY)-1,$L(ADEY))

 +22      ;I ADEY<80 W *7,!," Must be 1980 or later." G DIR

 +23       SET ADEY=X

 +24      ;Y2000

           IF ADEY<1980

               WRITE *7,!," Must be 1980 or later."

               GOTO DIR

 +25      ;end Y2K fix block

 +26       SET ADEQ=3

 +27       IF ADEY_"."_ADEQ>$$QTR^ADEKNT5(DT)

               WRITE *7,!," You must select a prior Fiscal year."

               GOTO DIR

 +28       SET ADEYQ=ADEY_".3"

 +29       IF '$DATA(ADEYQ(ADEYQ))

               WRITE !,"No statistics for FY"_ADEY_" have been compiled on this computer. "

               GOTO DIR

 +30       QUIT ADEYQ