- 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
