- ADEPDDS ; IHS/HQT/MJL - DENTIST MONTHLY REPORT ;07:03 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,DIRUT,DUOUT,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 MDATE^ADEPSUB G:$$HAT^ADEPQA() END
- ;
- ;GET AND LOCK UNIQUE SUBSCRIPT FOR THE REPORT GLOBAL
- S ADEU=$$ADEU^ADEPSUB()
- ; ^TMP is a transient, non-fileman working global.
- K ^TMP("ADEP",ADEU)
- S ^TMP("ADEP",ADEU)="RUNNING"
- ;
- D ASKDEV^ADEPSUB("ZTM^ADEPDDS","DENTAL MONTHLY REPORT PROCESSING")
- I POP K ^TMP("ADEP",ADEU) G END
- I $D(ZTSK) 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 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_"DENTIST MONTHLY REPORT PRINTING"_U_"PRINT^ADEPDDS"
- . 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,4)
- Q
- ;
- PRINT ;EP - TASKMAN PRINT PHASE
- D PRINT^ADEPSUB("[ADEP-ADEPMON]"," DENTIST MONTHLY REPORT FOR PERIOD")
- Q
- ADEPDDS ; IHS/HQT/MJL - DENTIST MONTHLY REPORT ;07:03 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,DIRUT,DUOUT,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 MDATE^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, non-fileman working global.
- +16 KILL ^TMP("ADEP",ADEU)
- +17 SET ^TMP("ADEP",ADEU)="RUNNING"
- +18 ;
- +19 DO ASKDEV^ADEPSUB("ZTM^ADEPDDS","DENTAL MONTHLY REPORT PROCESSING")
- +20 IF POP
- KILL ^TMP("ADEP",ADEU)
- GOTO END
- +21 IF $DATA(ZTSK)
- 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 CALC4^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 MONTHLY REPORT PRINTING"_U_"PRINT^ADEPDDS"
- 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,4)
- End DoDot:1
- +5 QUIT
- +6 ;
- PRINT ;EP - TASKMAN PRINT PHASE
- +1 DO PRINT^ADEPSUB("[ADEP-ADEPMON]"," DENTIST MONTHLY REPORT FOR PERIOD")
- +2 QUIT
