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 ---[H[J[2J[HSCRPW401 2247 printed Dec 13, 2024@02:43:41 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
