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 ;
