ADEKNT4.m

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

 ;;6.0;ADE;;APRIL 1999

 ;

ASKYQ() ;EP

 ;Displays periods for which objectives data

 ;have already been compiled in ^ADEKNT

 ;Asks for YEAR and QUARTER 

 ;beginning Y2K fix

 ;Default is most recent YYYY.Q

 ;Returns YYYY.Q

 ;Returns 0 if no valid YYYY.Q entered or hat out

 ;Prompts confirmation if a YYYY.Q is entered for

 ;which stats have already been compiled

 ;end Y2K fix block

 ;

 N ADEY,ADEQ,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

 ;

DIR ;

 ;beginning Y2K fix

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

 S DIR(0)="F^6:6"  ;Y2000

 S DIR("A")="Enter YEAR.QUARTER"

 S DIR("A",1)="Enter the calendar year and quarter for which you wish to compile statistics"

 ;S DIR("A",2)="Using the format YY.Q where YY is the last 2 digits of the year"

 S DIR("A",2)="Using the format YYYY.Q where YYYY is the 4 digit year" ;Y2000

 ;S DIR("A",3)="and Q is the quarter of the year, e.g. 94.2 for the second quarter of 1994. "

 S DIR("A",3)="and Q is the quarter of the year, e.g. 1994.2 for the second quarter of 1994. "  ;Y2000

 S DIR("A",4)=" "

 ;S DIR("?")="Enter the Year and Quarter in the form YY.Q"

 S DIR("?")="Enter the Year and Quarter in the form YYYY.Q"  ;Y2000

 S DIR("B")=+$$QTR^ADEKNT5(DT)

 K:$D(ADEYQ(DIR("B"))) DIR("B")

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

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

 . W !,?5,ADEYQ

 D ^DIR

 I $$HAT^ADEPQA Q 0

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

 I X'?4N1"."1N 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

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

 ;end Y2K fix block

 S ADEQ=$P(X,".",2)

 I ADEQ<1!(ADEQ>4) W *7," Quarter must be 1, 2, 3 or 4." G DIR

 I ADEY_"."_ADEQ>$$QTR^ADEKNT5(DT) W *7," Must be "_+$$QTR^ADEKNT5(DT)_" or earlier." G DIR

 S ADEYQ=ADEY_"."_ADEQ

 I '$D(ADEYQ(ADEYQ)) Q ADEYQ

 K DIR

 S DIR(0)="YA",DIR("B")="NO"

 W !!,"Statistics have already been compiled for period "_ADEYQ

 S DIR("A")="Do you want to re-compile the statistics for this period? "

 D ^DIR

 G:'Y DIR

 Q ADEYQ

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

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;

ASKYQ()   ;EP

 +1       ;Displays periods for which objectives data

 +2       ;have already been compiled in ^ADEKNT

 +3       ;Asks for YEAR and QUARTER 

 +4       ;beginning Y2K fix

 +5       ;Default is most recent YYYY.Q

 +6       ;Returns YYYY.Q

 +7       ;Returns 0 if no valid YYYY.Q entered or hat out

 +8       ;Prompts confirmation if a YYYY.Q is entered for

 +9       ;which stats have already been compiled

 +10      ;end Y2K fix block

 +11      ;

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

 +13      ;

 +14       SET ADEYQ=0

 +15       FOR 

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

               IF ADEYQ=""

                   QUIT 

               Begin DoDot:1

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

 +17               SET ADEYQ(ADEYQ)=""

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

               End DoDot:1

 +19      ;

DIR       ;

 +1       ;beginning Y2K fix

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

 +3       ;Y2000

           SET DIR(0)="F^6:6"

 +4        SET DIR("A")="Enter YEAR.QUARTER"

 +5        SET DIR("A",1)="Enter the calendar year and quarter for which you wish to compile statistics"

 +6       ;S DIR("A",2)="Using the format YY.Q where YY is the last 2 digits of the year"

 +7       ;Y2000

           SET DIR("A",2)="Using the format YYYY.Q where YYYY is the 4 digit year"

 +8       ;S DIR("A",3)="and Q is the quarter of the year, e.g. 94.2 for the second quarter of 1994. "

 +9       ;Y2000

           SET DIR("A",3)="and Q is the quarter of the year, e.g. 1994.2 for the second quarter of 1994. "

 +10       SET DIR("A",4)=" "

 +11      ;S DIR("?")="Enter the Year and Quarter in the form YY.Q"

 +12      ;Y2000

           SET DIR("?")="Enter the Year and Quarter in the form YYYY.Q"

 +13       SET DIR("B")=+$$QTR^ADEKNT5(DT)

 +14       IF $DATA(ADEYQ(DIR("B")))

               KILL DIR("B")

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

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

 +16      IF '$TEST

               SET ADEYQ=0

               WRITE !!!,"Statistics have already been compiled for the following quarters:"

               FOR 

                   SET ADEYQ=$ORDER(ADEYQ(ADEYQ))

                   IF 'ADEYQ

                       QUIT 

                   Begin DoDot:1

 +17                   WRITE !,?5,ADEYQ

                   End DoDot:1

 +18       DO ^DIR

 +19       IF $$HAT^ADEPQA

               QUIT 0

 +20      ;I X'?1.4N1"."1N W *7," ??" G DIR

 +21      ;Y2000

           IF X'?4N1"."1N

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

               GOTO DIR

 +22       SET ADEY=$PIECE(X,".")

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

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

 +25      ;Y2000

           IF ADEY<1980

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

               GOTO DIR

 +26      ;end Y2K fix block

 +27       SET ADEQ=$PIECE(X,".",2)

 +28       IF ADEQ<1!(ADEQ>4)

               WRITE *7," Quarter must be 1, 2, 3 or 4."

               GOTO DIR

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

               WRITE *7," Must be "_+$$QTR^ADEKNT5(DT)_" or earlier."

               GOTO DIR

 +30       SET ADEYQ=ADEY_"."_ADEQ

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

               QUIT ADEYQ

 +32       KILL DIR

 +33       SET DIR(0)="YA"

           SET DIR("B")="NO"

 +34       WRITE !!,"Statistics have already been compiled for period "_ADEYQ

 +35       SET DIR("A")="Do you want to re-compile the statistics for this period? "

 +36       DO ^DIR

 +37       IF 'Y

               GOTO DIR

 +38       QUIT ADEYQ