SCRPW401.m

SCRPW401 ;BPCIOFO/ACS - Diagnosis/Procedure Frequency Report ;06/23/99

 ;;5.3;Scheduling;**180**;Aug 13, 1993

 ;

 ;------------------------------------------------------------

 ;

 ; Purpose  : Rank and print the CPT modifiers

 ; Called by: SCRPW40

 ;

 ;

 ;INPUT     : MODARRAY(MOD ptr,TYPE)=COUNT

 ;            the full array referenced from SCRPW40 is -

 ;            ^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,SDMOD,TYPE))

 ;              SDIV  : division

 ;              SDPROC: pointer to CPT code

 ;              SDMOD : pointer to CPT modifier code

 ;              TYPE  : encounter "ENC" or quantity "QTY"

 ;

 ;OUTPUT    : none

 ;

 ;OTHER     : RANKMOD is the array to hold the ranked modifiers

 ;            for the current CPT code

 ;            LINEFLAG is used as a flag to indicate that a line

 ;            will be skipped before printing the next cpt code

 ;            (cpt codes are double spaced on the report, but not

 ;            immediately after printing the report headers, when

 ;            LINEFLAG=0)

 ;------------------------------------------------------------

 ;

START(MODARRAY) ;build array to hold ranked modifiers (by quantity)

 ;

 N SDMOD,RANKMOD,SDMODQTY

 ;

 ; spin through modifier array and get modifier quantity

 S SDMOD=0

 F  S SDMOD=$O(@MODARRAY@(SDMOD)) Q:'SDMOD  D

 . S SDMODQTY=$G(@MODARRAY@(SDMOD,"QTY"))

 . Q:'SDMODQTY

 . ;

 . ; put modifier quantity and code into new array

 . S RANKMOD(SDMODQTY,SDMOD)=""

 . Q

 ;

 ; loop through ranked modifiers in descending order

 S SDMODQTY=""

 F  S SDMODQTY=$O(RANKMOD(SDMODQTY),-1) Q:SDMODQTY=""  D

 . S SDMOD=""

 . F  S SDMOD=$O(RANKMOD(SDMODQTY,SDMOD),-1) Q:SDMOD=""  D

 .. ; check page length. go to new page if necessary.

 .. I $Y>(IOSL-4) D HDR^SCRPW40 D PRHD^SCRPW40 Q:SDOUT

 .. ;

 .. ; get modifier and desc

 .. N MODINFO,MODCODE,MODTEXT,SDMENC,SDMQTY

 .. S MODINFO=$$MOD^ICPTMOD(SDMOD,"I")

 .. Q:+MODINFO<0

 .. S MODCODE=$P(MODINFO,"^",2)

 .. S MODTEXT=$E($P(MODINFO,"^",3),1,28)

 .. S SDMENC="-"_$G(@MODARRAY@(SDMOD,"ENC"))

 .. S SDMQTY="-"_$G(@MODARRAY@(SDMOD,"QTY"))

 .. W !,?(C+2),"-",MODCODE,?(C+8),MODTEXT

 .. W ?(C+38),$J(SDMENC,9,0),?(C+50),$J(SDMQTY,9,0)

 .. Q

 . S LINEFLAG=1

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCRPW401   2247     printed  Feb 19, 2025@00:10:08                                                                                                                                                                                                    Page 2

SCRPW401  ;BPCIOFO/ACS - Diagnosis/Procedure Frequency Report ;06/23/99

 +1       ;;5.3;Scheduling;**180**;Aug 13, 1993

 +2       ;

 +3       ;------------------------------------------------------------

 +4       ;

 +5       ; Purpose  : Rank and print the CPT modifiers

 +6       ; Called by: SCRPW40

 +7       ;

 +8       ;

 +9       ;INPUT     : MODARRAY(MOD ptr,TYPE)=COUNT

 +10      ;            the full array referenced from SCRPW40 is -

 +11      ;            ^TMP("SCRPW",$J,SDIV,"PROC",1,SDPROC,SDMOD,TYPE))

 +12      ;              SDIV  : division

 +13      ;              SDPROC: pointer to CPT code

 +14      ;              SDMOD : pointer to CPT modifier code

 +15      ;              TYPE  : encounter "ENC" or quantity "QTY"

 +16      ;

 +17      ;OUTPUT    : none

 +18      ;

 +19      ;OTHER     : RANKMOD is the array to hold the ranked modifiers

 +20      ;            for the current CPT code

 +21      ;            LINEFLAG is used as a flag to indicate that a line

 +22      ;            will be skipped before printing the next cpt code

 +23      ;            (cpt codes are double spaced on the report, but not

 +24      ;            immediately after printing the report headers, when

 +25      ;            LINEFLAG=0)

 +26      ;------------------------------------------------------------

 +27      ;

START(MODARRAY) ;build array to hold ranked modifiers (by quantity)

 +1       ;

 +2        NEW SDMOD,RANKMOD,SDMODQTY

 +3       ;

 +4       ; spin through modifier array and get modifier quantity

 +5        SET SDMOD=0

 +6        FOR 

               SET SDMOD=$ORDER(@MODARRAY@(SDMOD))

               if 'SDMOD

                   QUIT 

               Begin DoDot:1

 +7                SET SDMODQTY=$GET(@MODARRAY@(SDMOD,"QTY"))

 +8                if 'SDMODQTY

                       QUIT 

 +9       ;

 +10      ; put modifier quantity and code into new array

 +11               SET RANKMOD(SDMODQTY,SDMOD)=""

 +12               QUIT 

               End DoDot:1

 +13      ;

 +14      ; loop through ranked modifiers in descending order

 +15       SET SDMODQTY=""

 +16       FOR 

               SET SDMODQTY=$ORDER(RANKMOD(SDMODQTY),-1)

               if SDMODQTY=""

                   QUIT 

               Begin DoDot:1

 +17               SET SDMOD=""

 +18               FOR 

                       SET SDMOD=$ORDER(RANKMOD(SDMODQTY,SDMOD),-1)

                       if SDMOD=""

                           QUIT 

                       Begin DoDot:2

 +19      ; check page length. go to new page if necessary.

 +20                       IF $Y>(IOSL-4)

                               DO HDR^SCRPW40

                               DO PRHD^SCRPW40

                               if SDOUT

                                   QUIT 

 +21      ;

 +22      ; get modifier and desc

 +23                       NEW MODINFO,MODCODE,MODTEXT,SDMENC,SDMQTY

 +24                       SET MODINFO=$$MOD^ICPTMOD(SDMOD,"I")

 +25                       if +MODINFO<0

                               QUIT 

 +26                       SET MODCODE=$PIECE(MODINFO,"^",2)

 +27                       SET MODTEXT=$EXTRACT($PIECE(MODINFO,"^",3),1,28)

 +28                       SET SDMENC="-"_$GET(@MODARRAY@(SDMOD,"ENC"))

 +29                       SET SDMQTY="-"_$GET(@MODARRAY@(SDMOD,"QTY"))

 +30                       WRITE !,?(C+2),"-",MODCODE,?(C+8),MODTEXT

 +31                       WRITE ?(C+38),$JUSTIFY(SDMENC,9,0),?(C+50),$JUSTIFY(SDMQTY,9,0)

 +32                       QUIT 

                       End DoDot:2

 +33               SET LINEFLAG=1

 +34               QUIT 

               End DoDot:1

 +35       QUIT