- ADEPHYY ; IHS/HQT/MJL - HYGIENIST ANNUAL REPORT ;07:10 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 hygienists/therapists DFNs in ADEHYG
- S ADEHYG=$$HYG^ADEPSUB1()
- I 'ADEHYG W !!,"There is no one classed as a HYGIENIST/THERAPIST in the PROVIDER file!" G END
- ;GET DATE RANGE
- D YDATE^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^ADEPHYY","HYGIENIST ANNUAL 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
- 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 ANNUAL REPORT PRINTING"_U_"PRINT^ADEPHYY"
- . 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-ADEPYR]"," HYGIENIST/THERAPIST ANNUAL REPORT FOR YEAR")
- Q
- ADEPHYY ; IHS/HQT/MJL - HYGIENIST ANNUAL REPORT ;07:10 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 hygienists/therapists DFNs in ADEHYG
- +6 SET ADEHYG=$$HYG^ADEPSUB1()
- +7 IF 'ADEHYG
- WRITE !!,"There is no one classed as a HYGIENIST/THERAPIST in the PROVIDER file!"
- GOTO END
- +8 ;GET DATE RANGE
- +9 DO YDATE^ADEPSUB
- IF $$HAT^ADEPQA()
- GOTO END
- +10 ;
- +11 ;GET AND LOCK UNIQUE SUBSCRIPT FOR THE REPORT GLOBAL
- +12 SET ADEU=$$ADEU^ADEPSUB()
- +13 ; ^TMP is a transient, non-fileman working global.
- +14 KILL ^TMP("ADEP",ADEU)
- +15 SET ^TMP("ADEP",ADEU)="RUNNING"
- +16 ;
- +17 DO ASKDEV^ADEPSUB("ZTM^ADEPHYY","HYGIENIST ANNUAL 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 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_"HYGIENIST ANNUAL REPORT PRINTING"_U_"PRINT^ADEPHYY"
- 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 HSCREEN^ADEPSUB3(ADEDFN,4)
- End DoDot:1
- +5 QUIT
- +6 ;
- PRINT ;EP - TASKMAN PRINT PHASE
- +1 DO PRINT^ADEPSUB("[ADEP-ADEPYR]"," HYGIENIST/THERAPIST ANNUAL REPORT FOR YEAR")
- +2 QUIT
