AQAQPR33.m

AQAQPR33 ;IHS/ANMC/LJF - DISCHARGES BY PROVIDER & DX; [ 05/27/92  11:25 AM ]

 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 ;

GETGRP ;EP;***> SUBRTN to print name of icd grouping

 S AQAQG=$O(^AQACGM("B",+$P(AQAQICD,"."),0)) Q:AQAQG=""

 S AQAQGRP=$P($G(^AQACGM(AQAQG,0)),U,2)  ;group pointer

 S AQAQGN=$G(^AQACCAT(AQAQGRP,0)),AQAQRNG=$P(AQAQGN,U)

 S AQAQGRP=$P(AQAQGN,U,2)_" ("_AQAQRNG_")"  ;name/range

 I $Y>(IOSL-6) D NEWPG^AQAQPR32 Q:AQAQSTOP=U

 W !! W ?80-$L(AQAQGRP)/2,AQAQGRP,! Q   ;print name & range

 ;

 ;

SUBCNT ;EP;***> SUBRTN to print subcount of icd grouping for provider

 I AQAQGCT=0 Q     ;no diagnoses for grouping

 W !,AQAQLIN2,!?27,"SUBCOUNT FOR ICD GROUP:  ",AQAQGCT,!,AQAQLINE,!

 S AQAQGCT=0,AQAQICDF=0 D GETGRP:AQAQICD'="" Q

 ;

 ;

PROVCNT ;EP;***> SUBRTN to print subcount for provider

 I AQAQGCT>0 D SUBCNT

 I $Y>(IOSL-5) D NEWPG^AQAQPR32 Q:AQAQSTOP=U

 I AQAQCDX=1 W !?20,"TOTAL DISCHARGES FOR PROVIDER:  ",AQAQPCT  ;prim

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

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

 Q

AQAQPR33  ;IHS/ANMC/LJF - DISCHARGES BY PROVIDER & DX; [ 05/27/92  11:25 AM ]

 +1       ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 +2       ;

GETGRP    ;EP;***> SUBRTN to print name of icd grouping

 +1        SET AQAQG=$ORDER(^AQACGM("B",+$PIECE(AQAQICD,"."),0))

           IF AQAQG=""

               QUIT 

 +2       ;group pointer

           SET AQAQGRP=$PIECE($GET(^AQACGM(AQAQG,0)),U,2)

 +3        SET AQAQGN=$GET(^AQACCAT(AQAQGRP,0))

           SET AQAQRNG=$PIECE(AQAQGN,U)

 +4       ;name/range

           SET AQAQGRP=$PIECE(AQAQGN,U,2)_" ("_AQAQRNG_")"

 +5        IF $Y>(IOSL-6)

               DO NEWPG^AQAQPR32

               IF AQAQSTOP=U

                   QUIT 

 +6       ;print name & range

           WRITE !!

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

           QUIT 

 +7       ;

 +8       ;

SUBCNT    ;EP;***> SUBRTN to print subcount of icd grouping for provider

 +1       ;no diagnoses for grouping

           IF AQAQGCT=0

               QUIT 

 +2        WRITE !,AQAQLIN2,!?27,"SUBCOUNT FOR ICD GROUP:  ",AQAQGCT,!,AQAQLINE,!

 +3        SET AQAQGCT=0

           SET AQAQICDF=0

           IF AQAQICD'=""

               DO GETGRP

           QUIT 

 +4       ;

 +5       ;

PROVCNT   ;EP;***> SUBRTN to print subcount for provider

 +1        IF AQAQGCT>0

               DO SUBCNT

 +2        IF $Y>(IOSL-5)

               DO NEWPG^AQAQPR32

               IF AQAQSTOP=U

                   QUIT 

 +3       ;prim

           IF AQAQCDX=1

               WRITE !?20,"TOTAL DISCHARGES FOR PROVIDER:  ",AQAQPCT

 +4       IF '$TEST

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

 +5        WRITE !,AQAQLINE

           SET AQAQTCT=AQAQTCT+AQAQPCT

           SET AQAQPCT=0

 +6        QUIT