PXBDCPT.m

PXBDCPT ;ISL/JVS,ESW - DISPLAY CPT ; 12/5/02 11:28am

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,73,89,108**;Aug 12, 1996

 ;

 ;

EN0 ;---Main entry point

 ;

 ;

HEAD ;--HEADER ON LIST

 S HEAD="- - E N C O U N T E R  P R O C E D U R E S (CPT CODES) - -"

 W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD,IOINLOW

 W IOELEOL K HEAD

 ;

 I $D(CLINIC) D PRV^PXBUTL2(CLINIC)

 ;

 ;I PXBCNT<11 D DISCPT1^PXBDCPT

 ;I PXBCNT<21&(PXBCNT>10) D DISCPT2^PXBDCPT

 ;I PXBCNT>20&(PXBCNT<31) D DISCPT3^PXBDCPT

 ;I PXBCNT>30&('$D(PXBNCPT)) 

 D DISCPT4^PXBDCPT("BEGIN")

 ;I PXBCNT>30&($D(PXBNCPT)) D DISCPT4^PXBDCPT("SAME")

 Q

 ;

 ;

 ;

ARRAY ;Set all CPT codes and modifiers into ^TMP("PXBDCPT",$J,"DSP"

 ;for display

 ;

 N PXSQ,ENTRY,PXMD,PXDESC

 S PXTMP="^TMP(""PXBDCPT"""_","_$J_","_"""DSP"")"

 K @PXTMP

 S (PXTLNS,PXSQ)=0

 F  S PXSQ=$O(PXBSAM(PXSQ)) Q:'PXSQ  D

 .S PXTLNS=PXTLNS+1

 .S ENTRY=PXBSAM(PXSQ)

 .S PXBSAM(PXSQ,"LINE")=PXTLNS

 .I $D(PXBNCPT($P(ENTRY,U))) D

 ..;I PXBNCPT($P(ENTRY,U))]"",'$D(PXBSKY(PXSQ,PXBNCPT($P(ENTRY,U)))) Q

 ..Q:'$D(PXBNCPT($P(ENTRY,U),$O(PXBSKY(PXSQ,0))))

 ..S $P(ENTRY,U)=$P(ENTRY,U)_"*"

 .S @PXTMP@(PXTLNS,0)=PXSQ_U_$P(ENTRY,U)_U_$P(ENTRY,U,2)_U_$P(ENTRY,U,4)_U_$E($P(ENTRY,U,3),1,24)

 .S PXMD=""

 .F  S PXMD=$O(PXBSAM(PXSQ,"MOD",PXMD)) Q:'PXMD  D

 ..S PXTLNS=PXTLNS+1

 ..S PXMOD=PXBSAM(PXSQ,"MOD",PXMD)

 ..S PXDESC=$P($$MODP^ICPTMOD($E(ENTRY,1,5),PXMOD,"E"),U,2) ;PX*108

 ..S @PXTMP@(PXTLNS,0)=0_U_PXMOD_U_$E(PXDESC,1,54)

 Q

DISCPT1 ;--Display the CPT Data

 ;

 N ENTRY,J

 D UNDON^PXBCC

 W !,"No.",?4,"CPT CODE",?14,"QUANTITY",?25,"DESCRIPTION",?55,"PROVIDER",?75,$C(32)

 W IOEDEOP

 D UNDOFF^PXBCC

 ;

 ;

 S J=0

 F  S J=$O(PXBSAM(J)) Q:J=""  D

 .S ENTRY=$G(PXBSAM(J))

 .I $D(PXBNCPT($P(ENTRY,U,1))) S $P(ENTRY,U,1)=$P(ENTRY,U,1)_"*"

 .W !,J,?4,$P(ENTRY,U,1),?15,$P(ENTRY,U,2)

 .W ?25,$P(ENTRY,U,4),?55,$E($P(ENTRY,U,3),1,24)

 .;---Display associated modifiers

 .S PXSIEN=""

 .F  S PXSIEN=$O(PXBSAM(J,"MOD",PXSIEN)) Q:PXSIEN=""  D

 ..N PXWRAP,PXMOD,PXDESC,PXLN

 ..S PXMOD=PXBSAM(J,"MOD",PXSIEN)

 ..S PXDESC=$P($$MOD^ICPTMOD(PXMOD,"E"),U,3)

 ..D WRAP^PXCEVFI4(PXDESC,58,.PXWRAP)

 ..F PXLN=1:1 Q:$G(PXWRAP(PXLN))=""  D

 ...W:PXLN=1 !,?4,"CPT Modifier: "_PXMOD

 ...W:PXLN>1 !

 ...W ?22,PXWRAP(PXLN)

 ;---Write no entries if none exsist

 I '$D(PXBSAM) D NONE^PXBUTL(2)

 Q

 ;

DISCPT2 ;--display of cpt data two columns more that 10 entries.

 ;

 N ENTRY,J,PXA

 D GSET^%ZISS

 D UNDON^PXBCC W IOG1

 W !,"NO",?4,"CPT",?10,"QUA",?14,"DESCRIPTION",?39,IOVL

 W ?40,"NO",?44,"CPT",?50,"QUA",?54,"NARRATIVE"

 W IOEDEOP

 D UNDOFF^PXBCC

 ;

 ;

 ;

 S J=0 F  S J=$O(PXBSAM(J)) Q:J=""  D

 .S ENTRY(J)=$G(PXBSAM(J)) I $D(PXBNCPT($P(ENTRY(J),U,1))) S $P(ENTRY(J),U,1)=$P(ENTRY(J),U,1)_"*"

 F J=1:1:10 D

 .W !,J,?4,$P(ENTRY(J),U,1),?11,$P(ENTRY(J),U,2),?14,$E($P(ENTRY(J),U,4),1,24)

 .I $D(ENTRY(J+10)) W ?39,IOVL,(J+10),?44,$P(ENTRY(J+10),U,1),?51,$P(ENTRY(J+10),U,2),?54,$E($P(ENTRY(J+10),U,4),1,24)

 W IOG0

 Q

 ;

DISCPT3 ;--display of cpt data three colums more that 20 entries.

 N ENTRY,J,PXA

 D GSET^%ZISS

 D UNDON^PXBCC W IOG1

 W !,"NO",?4,"CPT",?10,"QUA",?14,"NARRATIVE",?25,IOVL

 W ?26,"NO",?30,"CPT",?36,"QUA",?40,"NARRATIVE",?51,IOVL

 W ?52,"NO",?56,"CPT",?62,"QUA",?66,"NARRATIVE"

 W IOEDEOP

 D UNDOFF^PXBCC

 ;

 S J=0 F  S J=$O(PXBSAM(J)) Q:J=""  D

 .S ENTRY(J)=$G(PXBSAM(J)) I $D(PXBNCPT($P(ENTRY(J),U,1))) S $P(ENTRY(J),U,1)=$P(ENTRY(J),U,1)_"*"

 F J=1:1:10 D

 .W !,J,?4,$P(ENTRY(J),U,1),?11,$P(ENTRY(J),U,2),?14,$E($P(ENTRY(J),U,4),1,10)

 .I $D(ENTRY(J+10)) W ?25,IOVL,(J+10),?30,$P(ENTRY(J+10),U,1),?37,$P(ENTRY(J+10),U,2),?40,$E($P(ENTRY(J+10),U,4),1,10)

 .I $D(ENTRY(J+20)) W ?51,IOVL,(J+20),?56,$P(ENTRY(J+20),U,1),?63,$P(ENTRY(J+20),U,2),?66,$E($P(ENTRY(J+20),U,4),1,10)

 W IOG0

 Q

 ;

DISCPT4(SIGN) ;--Display the CPT Data

 ;

 ;SIGN=

 ; '+' add 10 to the starting point in ^TMP("PXBDCPT",$J)

 ; '-' subtract 10 from the starting point but not less that 0

 ; 'BEGIN' start at the beginning

 ; 'SAME' start stays where it's at

 ; '3'--any number set start to that number

 ;

 N PXBSTART,PXTMP

 D ARRAY

 I SIGN="BEGIN" S ^TMP("PXBDCPT",$J,"START")=0,PXBSTART=0

 I SIGN="SAME" S PXBSTART=^TMP("PXBDCPT",$J,"START")

 I SIGN="+" D

 .S PXBSTART=($G(^TMP("PXBDCPT",$J,"START"))+10)

 .I PXBSTART'<PXTLNS S PXBSTART=PXBSTART-10

 .S ^TMP("PXBDCPT",$J,"START")=PXBSTART

 I SIGN="-" D

 .S PXBSTART=$G(^TMP("PXBDCPT",$J,"START"))-10

 .S ^TMP("PXBDCPT",$J,"START")=PXBSTART

 .I PXBSTART<0 S PXBSTART=0 S ^TMP("PXBDCPT",$J,"START")=0

 I +SIGN>0&(SIGN#10) D  Q:^TMP("PXBDCPT",$J,"START")=PXBSTART  S ^TMP("PXBDCPT",$J,"START")=PXBSTART

 .S PXBSTART=$P((SIGN/10),".")*10

 .S:PXBSTART<10 PXBSTART=0

 I +SIGN>0&'(SIGN#10) D  Q:^TMP("PXBDCPT",$J,"START")=PXBSTART  S ^TMP("PXBDCPT",$J,"START")=PXBSTART

 .S PXBSTART=(($P((SIGN/10),".")*10)-10)

 .S:PXBSTART<10 PXBSTART=0

 ;

 ;

 I SIGN'="BEGIN" D LOC^PXBCC(3,0) W IOEDEOP

 ;

HEAD4 ;--HEADER ON LIST

 S HEAD="- - E N C O U N T E R  P R O C E D U R E S (CPT CODES) - -"

 W IOINHI,!,IOCUU,?(IOM-$L(HEAD))\2,HEAD,IOINLOW

 W IOELEOL K HEAD

 ;

 ;

 N ENTRY,J

 D UNDON^PXBCC

 W !,"No.",?4,"CPT CODE",?14,"QUANTITY",?25,"DESCRIPTION",?55,"PROVIDER",?75,$C(32)

 W IOEDEOP

 D UNDOFF^PXBCC

 ;

 ;

 N PXSIEN,PXDESC,PXMOD,PXQ,PXLNS

 S J=PXBSTART,PXQ=""

 S PXLNS=0

 F  S J=$O(@PXTMP@(J)) Q:J=""  D  Q:PXQ

 .S PXLNS=PXLNS+1

 .I '(PXLNS#11) D  Q

 ..S ^TMP("PXBDCPT",$J,"START")=PXBSTART

 ..S PXQ=1

 .I +@PXTMP@(J,0) D

 ..W !,$P(^(0),U),?4,$P(^(0),U,2),?15,$P(^(0),U,3)

 ..W ?25,$P(^(0),U,4),?55,$P(^(0),U,5)

 .E  D

 ..W !?4,"CPT Modifier: "_$P(^(0),U,2)_"  "_$P(^(0),U,3)

 I SIGN'="BEGIN" W !!

 Q

 ;

PXBDCPT   ;ISL/JVS,ESW - DISPLAY CPT ; 12/5/02 11:28am

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,73,89,108**;Aug 12, 1996

 +2       ;

 +3       ;

EN0       ;---Main entry point

 +1       ;

 +2       ;

HEAD      ;--HEADER ON LIST

 +1        SET HEAD="- - E N C O U N T E R  P R O C E D U R E S (CPT CODES) - -"

 +2        WRITE IOINHI,!,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD,IOINLOW

 +3        WRITE IOELEOL

           KILL HEAD

 +4       ;

 +5        IF $DATA(CLINIC)

               DO PRV^PXBUTL2(CLINIC)

 +6       ;

 +7       ;I PXBCNT<11 D DISCPT1^PXBDCPT

 +8       ;I PXBCNT<21&(PXBCNT>10) D DISCPT2^PXBDCPT

 +9       ;I PXBCNT>20&(PXBCNT<31) D DISCPT3^PXBDCPT

 +10      ;I PXBCNT>30&('$D(PXBNCPT)) 

 +11       DO DISCPT4^PXBDCPT("BEGIN")

 +12      ;I PXBCNT>30&($D(PXBNCPT)) D DISCPT4^PXBDCPT("SAME")

 +13       QUIT 

 +14      ;

 +15      ;

 +16      ;

ARRAY     ;Set all CPT codes and modifiers into ^TMP("PXBDCPT",$J,"DSP"

 +1       ;for display

 +2       ;

 +3        NEW PXSQ,ENTRY,PXMD,PXDESC

 +4        SET PXTMP="^TMP(""PXBDCPT"""_","_$JOB_","_"""DSP"")"

 +5        KILL @PXTMP

 +6        SET (PXTLNS,PXSQ)=0

 +7        FOR 

               SET PXSQ=$ORDER(PXBSAM(PXSQ))

               IF 'PXSQ

                   QUIT 

               Begin DoDot:1

 +8                SET PXTLNS=PXTLNS+1

 +9                SET ENTRY=PXBSAM(PXSQ)

 +10               SET PXBSAM(PXSQ,"LINE")=PXTLNS

 +11               IF $DATA(PXBNCPT($PIECE(ENTRY,U)))

                       Begin DoDot:2

 +12      ;I PXBNCPT($P(ENTRY,U))]"",'$D(PXBSKY(PXSQ,PXBNCPT($P(ENTRY,U)))) Q

 +13                       IF '$DATA(PXBNCPT($PIECE(ENTRY,U),$ORDER(PXBSKY(PXSQ,0))))

                               QUIT 

 +14                       SET $PIECE(ENTRY,U)=$PIECE(ENTRY,U)_"*"

                       End DoDot:2

 +15               SET @PXTMP@(PXTLNS,0)=PXSQ_U_$PIECE(ENTRY,U)_U_$PIECE(ENTRY,U,2)_U_$PIECE(ENTRY,U,4)_U_$EXTRACT($PIECE(ENTRY,U,3),1,24)

 +16               SET PXMD=""

 +17               FOR 

                       SET PXMD=$ORDER(PXBSAM(PXSQ,"MOD",PXMD))

                       IF 'PXMD

                           QUIT 

                       Begin DoDot:2

 +18                       SET PXTLNS=PXTLNS+1

 +19                       SET PXMOD=PXBSAM(PXSQ,"MOD",PXMD)

 +20      ;PX*108

                           SET PXDESC=$PIECE($$MODP^ICPTMOD($EXTRACT(ENTRY,1,5),PXMOD,"E"),U,2)

 +21                       SET @PXTMP@(PXTLNS,0)=0_U_PXMOD_U_$EXTRACT(PXDESC,1,54)

                       End DoDot:2

               End DoDot:1

 +22       QUIT 

DISCPT1   ;--Display the CPT Data

 +1       ;

 +2        NEW ENTRY,J

 +3        DO UNDON^PXBCC

 +4        WRITE !,"No.",?4,"CPT CODE",?14,"QUANTITY",?25,"DESCRIPTION",?55,"PROVIDER",?75,$CHAR(32)

 +5        WRITE IOEDEOP

 +6        DO UNDOFF^PXBCC

 +7       ;

 +8       ;

 +9        SET J=0

 +10       FOR 

               SET J=$ORDER(PXBSAM(J))

               IF J=""

                   QUIT 

               Begin DoDot:1

 +11               SET ENTRY=$GET(PXBSAM(J))

 +12               IF $DATA(PXBNCPT($PIECE(ENTRY,U,1)))

                       SET $PIECE(ENTRY,U,1)=$PIECE(ENTRY,U,1)_"*"

 +13               WRITE !,J,?4,$PIECE(ENTRY,U,1),?15,$PIECE(ENTRY,U,2)

 +14               WRITE ?25,$PIECE(ENTRY,U,4),?55,$EXTRACT($PIECE(ENTRY,U,3),1,24)

 +15      ;---Display associated modifiers

 +16               SET PXSIEN=""

 +17               FOR 

                       SET PXSIEN=$ORDER(PXBSAM(J,"MOD",PXSIEN))

                       IF PXSIEN=""

                           QUIT 

                       Begin DoDot:2

 +18                       NEW PXWRAP,PXMOD,PXDESC,PXLN

 +19                       SET PXMOD=PXBSAM(J,"MOD",PXSIEN)

 +20                       SET PXDESC=$PIECE($$MOD^ICPTMOD(PXMOD,"E"),U,3)

 +21                       DO WRAP^PXCEVFI4(PXDESC,58,.PXWRAP)

 +22                       FOR PXLN=1:1

                               IF $GET(PXWRAP(PXLN))=""

                                   QUIT 

                               Begin DoDot:3

 +23                               IF PXLN=1

                                       WRITE !,?4,"CPT Modifier: "_PXMOD

 +24                               IF PXLN>1

                                       WRITE !

 +25                               WRITE ?22,PXWRAP(PXLN)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +26      ;---Write no entries if none exsist

 +27       IF '$DATA(PXBSAM)

               DO NONE^PXBUTL(2)

 +28       QUIT 

 +29      ;

DISCPT2   ;--display of cpt data two columns more that 10 entries.

 +1       ;

 +2        NEW ENTRY,J,PXA

 +3        DO GSET^%ZISS

 +4        DO UNDON^PXBCC

           WRITE IOG1

 +5        WRITE !,"NO",?4,"CPT",?10,"QUA",?14,"DESCRIPTION",?39,IOVL

 +6        WRITE ?40,"NO",?44,"CPT",?50,"QUA",?54,"NARRATIVE"

 +7        WRITE IOEDEOP

 +8        DO UNDOFF^PXBCC

 +9       ;

 +10      ;

 +11      ;

 +12       SET J=0

           FOR 

               SET J=$ORDER(PXBSAM(J))

               IF J=""

                   QUIT 

               Begin DoDot:1

 +13               SET ENTRY(J)=$GET(PXBSAM(J))

                   IF $DATA(PXBNCPT($PIECE(ENTRY(J),U,1)))

                       SET $PIECE(ENTRY(J),U,1)=$PIECE(ENTRY(J),U,1)_"*"

               End DoDot:1

 +14       FOR J=1:1:10

               Begin DoDot:1

 +15               WRITE !,J,?4,$PIECE(ENTRY(J),U,1),?11,$PIECE(ENTRY(J),U,2),?14,$EXTRACT($PIECE(ENTRY(J),U,4),1,24)

 +16               IF $DATA(ENTRY(J+10))

                       WRITE ?39,IOVL,(J+10),?44,$PIECE(ENTRY(J+10),U,1),?51,$PIECE(ENTRY(J+10),U,2),?54,$EXTRACT($PIECE(ENTRY(J+10),U,4),1,24)

               End DoDot:1

 +17       WRITE IOG0

 +18       QUIT 

 +19      ;

DISCPT3   ;--display of cpt data three colums more that 20 entries.

 +1        NEW ENTRY,J,PXA

 +2        DO GSET^%ZISS

 +3        DO UNDON^PXBCC

           WRITE IOG1

 +4        WRITE !,"NO",?4,"CPT",?10,"QUA",?14,"NARRATIVE",?25,IOVL

 +5        WRITE ?26,"NO",?30,"CPT",?36,"QUA",?40,"NARRATIVE",?51,IOVL

 +6        WRITE ?52,"NO",?56,"CPT",?62,"QUA",?66,"NARRATIVE"

 +7        WRITE IOEDEOP

 +8        DO UNDOFF^PXBCC

 +9       ;

 +10       SET J=0

           FOR 

               SET J=$ORDER(PXBSAM(J))

               IF J=""

                   QUIT 

               Begin DoDot:1

 +11               SET ENTRY(J)=$GET(PXBSAM(J))

                   IF $DATA(PXBNCPT($PIECE(ENTRY(J),U,1)))

                       SET $PIECE(ENTRY(J),U,1)=$PIECE(ENTRY(J),U,1)_"*"

               End DoDot:1

 +12       FOR J=1:1:10

               Begin DoDot:1

 +13               WRITE !,J,?4,$PIECE(ENTRY(J),U,1),?11,$PIECE(ENTRY(J),U,2),?14,$EXTRACT($PIECE(ENTRY(J),U,4),1,10)

 +14               IF $DATA(ENTRY(J+10))

                       WRITE ?25,IOVL,(J+10),?30,$PIECE(ENTRY(J+10),U,1),?37,$PIECE(ENTRY(J+10),U,2),?40,$EXTRACT($PIECE(ENTRY(J+10),U,4),1,10)

 +15               IF $DATA(ENTRY(J+20))

                       WRITE ?51,IOVL,(J+20),?56,$PIECE(ENTRY(J+20),U,1),?63,$PIECE(ENTRY(J+20),U,2),?66,$EXTRACT($PIECE(ENTRY(J+20),U,4),1,10)

               End DoDot:1

 +16       WRITE IOG0

 +17       QUIT 

 +18      ;

DISCPT4(SIGN) ;--Display the CPT Data

 +1       ;

 +2       ;SIGN=

 +3       ; '+' add 10 to the starting point in ^TMP("PXBDCPT",$J)

 +4       ; '-' subtract 10 from the starting point but not less that 0

 +5       ; 'BEGIN' start at the beginning

 +6       ; 'SAME' start stays where it's at

 +7       ; '3'--any number set start to that number

 +8       ;

 +9        NEW PXBSTART,PXTMP

 +10       DO ARRAY

 +11       IF SIGN="BEGIN"

               SET ^TMP("PXBDCPT",$JOB,"START")=0

               SET PXBSTART=0

 +12       IF SIGN="SAME"

               SET PXBSTART=^TMP("PXBDCPT",$JOB,"START")

 +13       IF SIGN="+"

               Begin DoDot:1

 +14               SET PXBSTART=($GET(^TMP("PXBDCPT",$JOB,"START"))+10)

 +15               IF PXBSTART'<PXTLNS

                       SET PXBSTART=PXBSTART-10

 +16               SET ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

               End DoDot:1

 +17       IF SIGN="-"

               Begin DoDot:1

 +18               SET PXBSTART=$GET(^TMP("PXBDCPT",$JOB,"START"))-10

 +19               SET ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

 +20               IF PXBSTART<0

                       SET PXBSTART=0

                       SET ^TMP("PXBDCPT",$JOB,"START")=0

               End DoDot:1

 +21       IF +SIGN>0&(SIGN#10)

               Begin DoDot:1

 +22               SET PXBSTART=$PIECE((SIGN/10),".")*10

 +23               IF PXBSTART<10

                       SET PXBSTART=0

               End DoDot:1

               IF ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

                   QUIT 

               SET ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

 +24       IF +SIGN>0&'(SIGN#10)

               Begin DoDot:1

 +25               SET PXBSTART=(($PIECE((SIGN/10),".")*10)-10)

 +26               IF PXBSTART<10

                       SET PXBSTART=0

               End DoDot:1

               IF ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

                   QUIT 

               SET ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

 +27      ;

 +28      ;

 +29       IF SIGN'="BEGIN"

               DO LOC^PXBCC(3,0)

               WRITE IOEDEOP

 +30      ;

HEAD4     ;--HEADER ON LIST

 +1        SET HEAD="- - E N C O U N T E R  P R O C E D U R E S (CPT CODES) - -"

 +2        WRITE IOINHI,!,IOCUU,?(IOM-$LENGTH(HEAD))\2,HEAD,IOINLOW

 +3        WRITE IOELEOL

           KILL HEAD

 +4       ;

 +5       ;

 +6        NEW ENTRY,J

 +7        DO UNDON^PXBCC

 +8        WRITE !,"No.",?4,"CPT CODE",?14,"QUANTITY",?25,"DESCRIPTION",?55,"PROVIDER",?75,$CHAR(32)

 +9        WRITE IOEDEOP

 +10       DO UNDOFF^PXBCC

 +11      ;

 +12      ;

 +13       NEW PXSIEN,PXDESC,PXMOD,PXQ,PXLNS

 +14       SET J=PXBSTART

           SET PXQ=""

 +15       SET PXLNS=0

 +16       FOR 

               SET J=$ORDER(@PXTMP@(J))

               IF J=""

                   QUIT 

               Begin DoDot:1

 +17               SET PXLNS=PXLNS+1

 +18               IF '(PXLNS#11)

                       Begin DoDot:2

 +19                       SET ^TMP("PXBDCPT",$JOB,"START")=PXBSTART

 +20                       SET PXQ=1

                       End DoDot:2

                       QUIT 

 +21               IF +@PXTMP@(J,0)

                       Begin DoDot:2

 +22                       WRITE !,$PIECE(^(0),U),?4,$PIECE(^(0),U,2),?15,$PIECE(^(0),U,3)

 +23                       WRITE ?25,$PIECE(^(0),U,4),?55,$PIECE(^(0),U,5)

                       End DoDot:2

 +24              IF '$TEST

                       Begin DoDot:2

 +25                       WRITE !?4,"CPT Modifier: "_$PIECE(^(0),U,2)_"  "_$PIECE(^(0),U,3)

                       End DoDot:2

               End DoDot:1

               IF PXQ

                   QUIT 

 +26       IF SIGN'="BEGIN"

               WRITE !!

 +27       QUIT 

 +28      ;