ADEPHY.m

ADEPHY ; IHS/HQT/MJL - HYG/THER MONTHLY REPORT ;07:09 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;

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

 K DTOUT,DUOUT,DIRUT,DIROUT

 ;Put hygienists/therapists DFNs in ADEHYG

 S ADEHYG=$$HYG^ADEPSUB1()

 I 'ADEHYG D  G END

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

 ;GET DATE RANGE

 D MDATE^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^ADEPHY","HYGIENIST MONTHLY 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 HSERIES^ADEPSUB1

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

 D ROLL

 ;Calculate percentages

 D CALC4^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_"HYGIENIST MONTHLY REPORT PRINTING"_U_"PRINT^ADEPHY"

 . 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 HSCREEN^ADEPSUB3(ADEDFN,4)

 Q

 ;

PRINT ;EP - TASKMAN PRINT PHASE

 D PRINT^ADEPSUB("[ADEP-ADEPMON]"," HYGIENIST/THERAPIST MONTHLY REPORT FOR PERIOD")

 Q

ADEPHY    ; IHS/HQT/MJL - HYG/THER MONTHLY REPORT ;07:09 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;

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

 +4        KILL DTOUT,DUOUT,DIRUT,DIROUT

 +5       ;Put hygienists/therapists DFNs in ADEHYG

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

 +7        IF 'ADEHYG

               Begin DoDot:1

 +8                WRITE !!,"There is no one classed as a DENTAL HYGIENIST in the PROVIDER file!"

               End DoDot:1

               GOTO END

 +9       ;GET DATE RANGE

 +10       DO MDATE^ADEPSUB

           IF $$HAT^ADEPQA()

               GOTO END

 +11      ;

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

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

 +14      ;^TMP is a transient report global

           KILL ^TMP("ADEP",ADEU)

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

 +16      ;

 +17       DO ASKDEV^ADEPSUB("ZTM^ADEPHY","HYGIENIST MONTHLY REPORT PROCESSING")

 +18       IF POP

               KILL ^TMP("ADEP",ADEU)

               GOTO END

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

 +20       IF $DATA(ZTQUEUED)

               GOTO END

 +21      ;

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 HSERIES^ADEPSUB1

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

 +5        DO ROLL

 +6       ;Calculate percentages

 +7        DO CALC4^ADEPSUB1

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

               GOTO END

 +9       ;Call DIP to print array

 +10       IF $DATA(ZTQUEUED)

               Begin DoDot:1

 +11               IF $DATA(IOT)

                       IF IOT'="HFS"

                           Begin DoDot:2

 +12                           SET ZTREQ=$HOROLOG_U_ADEIOP_U_"HYGIENIST MONTHLY REPORT PRINTING"_U_"PRINT^ADEPHY"

                           End DoDot:2

                           QUIT 

 +13               DO PRINT

                   QUIT 

               End DoDot:1

               GOTO END

 +14       IF '$DATA(ZTQUEUED)

               DO PRINT

 +15      ;

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 HSCREEN^ADEPSUB3(ADEDFN,4)

               End DoDot:1

 +5        QUIT 

 +6       ;

PRINT     ;EP - TASKMAN PRINT PHASE

 +1        DO PRINT^ADEPSUB("[ADEP-ADEPMON]"," HYGIENIST/THERAPIST MONTHLY REPORT FOR PERIOD")

 +2        QUIT