AQAQPR42.m

AQAQPR42 ;IHS/ANMC/LJF - DISCHARGES BY PROVIDER & DX; [ 07/09/1999  2:27 PM ]

 ;;2.2;STAFF CREDENTIALS;**8**;JULY 9, 1999

 ;;AQAQ*2*8;Y2K FIX;CS;2990708

 ;

 ;>>> initialize variables <<<

 S AQAQPAGE=0,AQAQSTOP="",AQAQDUZ=$P(^DIC(3,DUZ,0),U,2)

 S AQAQSITE=$P(^DIC(4,DUZ(2),0),U) ;set site

 ;BEGIN Y2K FIX BLOCK

 ;S AQAQRG=$E(AQAQBDT,4,5)_"/"_$E(AQAQBDT,6,7)_"/"_$E(AQAQBDT,2,3)_" to "

 ;S AQAQRG=AQAQRG_$E(AQAQEDT,4,5)_"/"_$E(AQAQEDT,6,7)_"/"_$E(AQAQEDT,2,3)

 S AQAQRG=$E(AQAQBDT,4,5)_"/"_$E(AQAQBDT,6,7)_"/"_($E(AQAQBDT,1,3)+1700)_" to " ; Y2000

 S AQAQRG=AQAQRG_$E(AQAQEDT,4,5)_"/"_$E(AQAQEDT,6,7)_"/"_($E(AQAQEDT,1,3)+1700) ; Y2000

 ;END Y2K FIX BLOCK 

 S AQAQLINE="",$P(AQAQLINE,"=",80)=""

 S AQAQLIN2="",$P(AQAQLIN2,"-",80)=""

 S (AQAQPCT,AQAQTCT)=0,AQAQPRV=""

 ;

 I '$D(^UTILITY("AQAQPR4",$J)) D HEAD W !!,">>> NO DATA FOUND!!" G WAIT

 ;

 ;>>> loop1=get next provider & start new page & new counts

 S AQAQPRV=0

LOOP1 S AQAQPRV=$O(^UTILITY("AQAQPR4",$J,AQAQPRV)) G TOTALS:AQAQPRV=""

 G END:AQAQSTOP=U I AQAQPAGE=0 D HEAD G PRVINIT

 E  D NEWPG G END:AQAQSTOP=U ;print heading with provider name

 S AQAQPCT=0 ;initialize provider count

 ;

PRVINIT ;

 ;>>> loop2=for provider, get each diagnostic category

 S AQAQGRP=0

LOOP2 S AQAQGRP=$O(^UTILITY("AQAQPR4",$J,AQAQPRV,AQAQGRP))

 I AQAQGRP="" D PROVCNT G END:AQAQSTOP=U G LOOP1 ;subtotal by prov

 S AQAQCNT=^UTILITY("AQAQPR4",$J,AQAQPRV,AQAQGRP)

 W !,$E(AQAQGRP,1,67),?70,AQAQCNT,! ;print counts

 S AQAQPCT=AQAQPCT+AQAQCNT ;increment count for provider

 I $Y>(IOSL-5) D NEWPG

 G END:AQAQSTOP=U G LOOP2 ;quit if "^" entered OR continue looping

 ;

 ;

TOTALS ;>>> print facility totals <<<

 I $Y>(IOSL-4) D NEWPG

 W !!,"***TOTAL DIAGNOSES:  ",AQAQTCT,"***",!,AQAQLINE

WAIT I IOST["C-" K DIR S DIR(0)="E",DIR("A")="RETURN to continue" D ^DIR

 ;

END ;EP;>>> eoj <<<

 W @IOF D ^%ZISC D KILL^AQAQUTIL K ^UTILITY("AQAQPR4",$J) Q

 ;

 ;

NEWPG ;***> SUBRTN for end of page control

 I IOST'?1"C-".E D HEAD S AQAQSTOP="" Q

 I AQAQPAGE>0 K DIR S DIR(0)="E" D ^DIR S AQAQSTOP=X

 I AQAQSTOP'=U D HEAD

 Q

 ;

HEAD ;***> SUBRTN to print heading

 W @IOF,!,AQAQLINE S AQAQPAGE=AQAQPAGE+1

 W !?11,"*****Confidential Patient Data Covered by Privacy Act*****"

 W !,AQAQDUZ,?80-$L(AQAQSITE)/2,AQAQSITE

 S AQAQTY="AMBULATORY DIAGNOSIS COUNTS BY PROVIDER"

 W ! D ^%T W ?80-$L(AQAQTY)/2,AQAQTY,?70,"Page: ",AQAQPAGE

 S Y=DT X ^DD("DD") W !,Y,?80-$L(AQAQPRV)/2,AQAQPRV ;prov name

 W !?30,AQAQRG,!,AQAQLINE ;date range and line

 W !,"Diagnostic Category",?70,"Count",!,AQAQLIN2

 I AQAQCDX=1 W !?25,"*** PRIMARY DIAGNOSES ONLY ***"

 E  W !?17,"*** PRIMARY & SECONDARY DIAGNOSES COUNTED ***"

 Q

 ;

 ;

PROVCNT ;***> SUBRTN to print provider subcount

 I $Y>(IOSL-4) D NEWPG Q:AQAQSTOP=U

 W !?20,"TOTAL DIAGNOSES FOR PROVIDER:  ",AQAQPCT

 W !,AQAQLINE S AQAQTCT=AQAQTCT+AQAQPCT,AQAQPCT=0

 Q

AQAQPR42  ;IHS/ANMC/LJF - DISCHARGES BY PROVIDER & DX; [ 07/09/1999  2:27 PM ]

 +1       ;;2.2;STAFF CREDENTIALS;**8**;JULY 9, 1999

 +2       ;;AQAQ*2*8;Y2K FIX;CS;2990708

 +3       ;

 +4       ;>>> initialize variables <<<

 +5        SET AQAQPAGE=0

           SET AQAQSTOP=""

           SET AQAQDUZ=$PIECE(^DIC(3,DUZ,0),U,2)

 +6       ;set site

           SET AQAQSITE=$PIECE(^DIC(4,DUZ(2),0),U)

 +7       ;BEGIN Y2K FIX BLOCK

 +8       ;S AQAQRG=$E(AQAQBDT,4,5)_"/"_$E(AQAQBDT,6,7)_"/"_$E(AQAQBDT,2,3)_" to "

 +9       ;S AQAQRG=AQAQRG_$E(AQAQEDT,4,5)_"/"_$E(AQAQEDT,6,7)_"/"_$E(AQAQEDT,2,3)

 +10      ; Y2000

           SET AQAQRG=$EXTRACT(AQAQBDT,4,5)_"/"_$EXTRACT(AQAQBDT,6,7)_"/"_($EXTRACT(AQAQBDT,1,3)+1700)_" to "

 +11      ; Y2000

           SET AQAQRG=AQAQRG_$EXTRACT(AQAQEDT,4,5)_"/"_$EXTRACT(AQAQEDT,6,7)_"/"_($EXTRACT(AQAQEDT,1,3)+1700)

 +12      ;END Y2K FIX BLOCK 

 +13       SET AQAQLINE=""

           SET $PIECE(AQAQLINE,"=",80)=""

 +14       SET AQAQLIN2=""

           SET $PIECE(AQAQLIN2,"-",80)=""

 +15       SET (AQAQPCT,AQAQTCT)=0

           SET AQAQPRV=""

 +16      ;

 +17       IF '$DATA(^UTILITY("AQAQPR4",$JOB))

               DO HEAD

               WRITE !!,">>> NO DATA FOUND!!"

               GOTO WAIT

 +18      ;

 +19      ;>>> loop1=get next provider & start new page & new counts

 +20       SET AQAQPRV=0

LOOP1      SET AQAQPRV=$ORDER(^UTILITY("AQAQPR4",$JOB,AQAQPRV))

           IF AQAQPRV=""

               GOTO TOTALS

 +1        IF AQAQSTOP=U

               GOTO END

           IF AQAQPAGE=0

               DO HEAD

               GOTO PRVINIT

 +2       ;print heading with provider name

          IF '$TEST

               DO NEWPG

               IF AQAQSTOP=U

                   GOTO END

 +3       ;initialize provider count

           SET AQAQPCT=0

 +4       ;

PRVINIT   ;

 +1       ;>>> loop2=for provider, get each diagnostic category

 +2        SET AQAQGRP=0

LOOP2      SET AQAQGRP=$ORDER(^UTILITY("AQAQPR4",$JOB,AQAQPRV,AQAQGRP))

 +1       ;subtotal by prov

           IF AQAQGRP=""

               DO PROVCNT

               IF AQAQSTOP=U

                   GOTO END

               GOTO LOOP1

 +2        SET AQAQCNT=^UTILITY("AQAQPR4",$JOB,AQAQPRV,AQAQGRP)

 +3       ;print counts

           WRITE !,$EXTRACT(AQAQGRP,1,67),?70,AQAQCNT,!

 +4       ;increment count for provider

           SET AQAQPCT=AQAQPCT+AQAQCNT

 +5        IF $Y>(IOSL-5)

               DO NEWPG

 +6       ;quit if "^" entered OR continue looping

           IF AQAQSTOP=U

               GOTO END

           GOTO LOOP2

 +7       ;

 +8       ;

TOTALS    ;>>> print facility totals <<<

 +1        IF $Y>(IOSL-4)

               DO NEWPG

 +2        WRITE !!,"***TOTAL DIAGNOSES:  ",AQAQTCT,"***",!,AQAQLINE

WAIT       IF IOST["C-"

               KILL DIR

               SET DIR(0)="E"

               SET DIR("A")="RETURN to continue"

               DO ^DIR

 +1       ;

END       ;EP;>>> eoj <<<

 +1        WRITE @IOF

           DO ^%ZISC

           DO KILL^AQAQUTIL

           KILL ^UTILITY("AQAQPR4",$JOB)

           QUIT 

 +2       ;

 +3       ;

NEWPG     ;***> SUBRTN for end of page control

 +1        IF IOST'?1"C-".E

               DO HEAD

               SET AQAQSTOP=""

               QUIT 

 +2        IF AQAQPAGE>0

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               SET AQAQSTOP=X

 +3        IF AQAQSTOP'=U

               DO HEAD

 +4        QUIT 

 +5       ;

HEAD      ;***> SUBRTN to print heading

 +1        WRITE @IOF,!,AQAQLINE

           SET AQAQPAGE=AQAQPAGE+1

 +2        WRITE !?11,"*****Confidential Patient Data Covered by Privacy Act*****"

 +3        WRITE !,AQAQDUZ,?80-$LENGTH(AQAQSITE)/2,AQAQSITE

 +4        SET AQAQTY="AMBULATORY DIAGNOSIS COUNTS BY PROVIDER"

 +5        WRITE !

           DO ^%T

           WRITE ?80-$LENGTH(AQAQTY)/2,AQAQTY,?70,"Page: ",AQAQPAGE

 +6       ;prov name

           SET Y=DT

           XECUTE ^DD("DD")

           WRITE !,Y,?80-$LENGTH(AQAQPRV)/2,AQAQPRV

 +7       ;date range and line

           WRITE !?30,AQAQRG,!,AQAQLINE

 +8        WRITE !,"Diagnostic Category",?70,"Count",!,AQAQLIN2

 +9        IF AQAQCDX=1

               WRITE !?25,"*** PRIMARY DIAGNOSES ONLY ***"

 +10      IF '$TEST

               WRITE !?17,"*** PRIMARY & SECONDARY DIAGNOSES COUNTED ***"

 +11       QUIT 

 +12      ;

 +13      ;

PROVCNT   ;***> SUBRTN to print provider subcount

 +1        IF $Y>(IOSL-4)

               DO NEWPG

               IF AQAQSTOP=U

                   QUIT 

 +2        WRITE !?20,"TOTAL DIAGNOSES FOR PROVIDER:  ",AQAQPCT

 +3        WRITE !,AQAQLINE

           SET AQAQTCT=AQAQTCT+AQAQPCT

           SET AQAQPCT=0

 +4        QUIT