ADEPDDM.m

ADEPDDM ; IHS/HQT/MJL - DENTIST QUARTERLY REPORT ;07:02 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;

 N ADEREP,ADEDDS,ADEDATE,ADESER,ADEDNAM,ADEWK1,ADEWK2,ADEWK3,ADEHYG,ADEHNAM,DIR,ADEIOP,ADEU

 K DTOUT,DUOUT,DIRUT,DIROUT

 ;Put dentists and hygienists/therapists DFNs in ADEDDS and ADEHYG

 S ADEDDS=$$DDS^ADEPSUB1()

 S ADEHYG=$$HYG^ADEPSUB1()

 I 'ADEDDS D  G END

 . W !!,"There is no one classed as a DENTIST in the PROVIDER file!"

 ;GET DATE RANGE

 D QDATE^ADEPSUB G:$$HAT^ADEPQA() END

 ;

 ;GET AND LOCK UNIQUE SUBSCRIPT FOR THE REPORT GLOBAL

 S ADEU=$$ADEU^ADEPSUB()

 K ^TMP("ADEP",ADEU) ;^TMP is a transient report global

 S ^TMP("ADEP",ADEU)="RUNNING"

 ;

 D ASKDEV^ADEPSUB("ZTM^ADEPDDM","DENTAL QUARTERLY REPORT PROCESSING")

 I POP K ^TMP("ADEP",ADEU) G END

 ;FHL 9/9/98 I $D(ZTSK) G END

 I $D(ZTQUEUED) G END

 ;

ZTM ;EP - TASKMAN PROCESSING PHASE

 I $D(ZTQUEUED) L +^TMP("ADEP",ADEU):1 I '$T S ZTREQ="@" G END

 ;Get code series

 D DSERIES^ADEPSUB1

 ;$O THRU date xref (?) and HIT if visit assoc w/ hyg

 D ROLL

 D CALC3^ADEPSUB1

 G:$O(^TMP("ADEP",ADEU,0))="" END

 ;Call DIP to print array

 I $D(ZTQUEUED) D  G END

 . I $D(IOT),IOT'="HFS" D  Q

 . . S ZTREQ=$H_U_ADEIOP_U_"DENTIST QUARTERLY REPORT PRINTING"_U_"PRINT^ADEPDDM"

 . D PRINT Q

 I '$D(ZTQUEUED) D PRINT

 ;

END K DUOUT,DTOUT,DIROUT,DIRUT

 D END^ADEPSUB4

 Q

 ;

 ;------->SUBROUTINES

 ;

ROLL ;

 N ADEBEG,ADEND,ADEDFN

 S ADEBEG=$P(ADEDATE,U,2)-1,ADEND=$P(ADEDATE,U,3)

 F  S ADEBEG=$O(^ADEPCD("AC",ADEBEG)) Q:ADEBEG>ADEND  Q:'+ADEBEG  S ADEDFN=0 D

 . F  S ADEDFN=$O(^ADEPCD("AC",ADEBEG,ADEDFN)) Q:'ADEDFN  D DSCREEN^ADEPSUB3(ADEDFN,3)

 Q

 ;

PRINT ;EP - TASKMAN PRINT PHASE

 D PRINT^ADEPSUB("[ADEP-ADEPQTR]"," DENTIST QUARTERLY REPORT FOR PERIOD")

 Q

ADEPDDM   ; IHS/HQT/MJL - DENTIST QUARTERLY REPORT ;07:02 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;

 +3        NEW ADEREP,ADEDDS,ADEDATE,ADESER,ADEDNAM,ADEWK1,ADEWK2,ADEWK3,ADEHYG,ADEHNAM,DIR,ADEIOP,ADEU

 +4        KILL DTOUT,DUOUT,DIRUT,DIROUT

 +5       ;Put dentists and hygienists/therapists DFNs in ADEDDS and ADEHYG

 +6        SET ADEDDS=$$DDS^ADEPSUB1()

 +7        SET ADEHYG=$$HYG^ADEPSUB1()

 +8        IF 'ADEDDS

               Begin DoDot:1

 +9                WRITE !!,"There is no one classed as a DENTIST in the PROVIDER file!"

               End DoDot:1

               GOTO END

 +10      ;GET DATE RANGE

 +11       DO QDATE^ADEPSUB

           IF $$HAT^ADEPQA()

               GOTO END

 +12      ;

 +13      ;GET AND LOCK UNIQUE SUBSCRIPT FOR THE REPORT GLOBAL

 +14       SET ADEU=$$ADEU^ADEPSUB()

 +15      ;^TMP is a transient report global

           KILL ^TMP("ADEP",ADEU)

 +16       SET ^TMP("ADEP",ADEU)="RUNNING"

 +17      ;

 +18       DO ASKDEV^ADEPSUB("ZTM^ADEPDDM","DENTAL QUARTERLY REPORT PROCESSING")

 +19       IF POP

               KILL ^TMP("ADEP",ADEU)

               GOTO END

 +20      ;FHL 9/9/98 I $D(ZTSK) G END

 +21       IF $DATA(ZTQUEUED)

               GOTO END

 +22      ;

ZTM       ;EP - TASKMAN PROCESSING PHASE

 +1        IF $DATA(ZTQUEUED)

               LOCK +^TMP("ADEP",ADEU):1

               IF '$TEST

                   SET ZTREQ="@"

                   GOTO END

 +2       ;Get code series

 +3        DO DSERIES^ADEPSUB1

 +4       ;$O THRU date xref (?) and HIT if visit assoc w/ hyg

 +5        DO ROLL

 +6        DO CALC3^ADEPSUB1

 +7        IF $ORDER(^TMP("ADEP",ADEU,0))=""

               GOTO END

 +8       ;Call DIP to print array

 +9        IF $DATA(ZTQUEUED)

               Begin DoDot:1

 +10               IF $DATA(IOT)

                       IF IOT'="HFS"

                           Begin DoDot:2

 +11                           SET ZTREQ=$HOROLOG_U_ADEIOP_U_"DENTIST QUARTERLY REPORT PRINTING"_U_"PRINT^ADEPDDM"

                           End DoDot:2

                           QUIT 

 +12               DO PRINT

                   QUIT 

               End DoDot:1

               GOTO END

 +13       IF '$DATA(ZTQUEUED)

               DO PRINT

 +14      ;

END        KILL DUOUT,DTOUT,DIROUT,DIRUT

 +1        DO END^ADEPSUB4

 +2        QUIT 

 +3       ;

 +4       ;------->SUBROUTINES

 +5       ;

ROLL      ;

 +1        NEW ADEBEG,ADEND,ADEDFN

 +2        SET ADEBEG=$PIECE(ADEDATE,U,2)-1

           SET ADEND=$PIECE(ADEDATE,U,3)

 +3        FOR 

               SET ADEBEG=$ORDER(^ADEPCD("AC",ADEBEG))

               IF ADEBEG>ADEND

                   QUIT 

               IF '+ADEBEG

                   QUIT 

               SET ADEDFN=0

               Begin DoDot:1

 +4                FOR 

                       SET ADEDFN=$ORDER(^ADEPCD("AC",ADEBEG,ADEDFN))

                       IF 'ADEDFN

                           QUIT 

                       DO DSCREEN^ADEPSUB3(ADEDFN,3)

               End DoDot:1

 +5        QUIT 

 +6       ;

PRINT     ;EP - TASKMAN PRINT PHASE

 +1        DO PRINT^ADEPSUB("[ADEP-ADEPQTR]"," DENTIST QUARTERLY REPORT FOR PERIOD")

 +2        QUIT