PXBPQUA ;ISL/JVS,ESW - PROMPT QUANTITY ; 6/18/03 6:34pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112,132,152**;Aug 12, 1996
;
;
;
;
QUA ;--Quantity
N TIMED,DATA,DIC,X
K PXBUT,EDATA
I '$D(IOEDEOP) D TERM^PXBCC
S TIMED="I '$T!(DATA[""^"")"
Q ;--SECOND ENTRY POINT
W !!,"How many times was this procedure performed: "_$S($G(CPTQUA):CPTQUA,1:1)_"//",IOELEOL R DATA:DTIME S EDATA=DATA
Q1 ;---
X TIMED I S PXBUT=1 D RSET^PXBDREQ("CPT") G QUAX
I DATA?.N1"E".NAP S DATA=" "_DATA
I DATA?24.N S DATA=$E(DATA,1,24)
;----SPACE BAR---
I DATA'=" ",DATA'["^",DATA'="" S ^DISV(DUZ,"PXBQUA-5")=DATA
I DATA=" ",$D(^DISV(DUZ,"PXBQUA-5")) S DATA=^DISV(DUZ,"PXBQUA-5") W DATA
;-----------------
I DATA]"",DATA'?.3N D:DATA="?" HELP^PXBUTL0("QU1") D:DATA="??" HELP^PXBUTL0("QU2") G Q
I DATA'="",DATA<1!(DATA>999) G Q
I DATA="",$G(CPTQUA) S DATA=CPTQUA
I DATA="",'$G(CPTQUA) S DATA=1
I DATA="?" D HELP^PXBUTL0("QU1") G QUA
I DATA="??" D HELP^PXBUTL0("QU2") G QUA
QFIN ;--FINISH UP VARIABLES
S QUA=DATA
N VALP S VALP=+$P($G(REQI),U,3)
I +QUA>1,VALP>0,$D(^IBE(357.69,VALP)) D
.;PX*1.0*132,IB*2*257
.I $$GET1^DIQ(357.69,VALP,.06,"I")'="Y" W !,"Only one E&M code allowed, quantity changed to 1." S QUA=1
S $P(REQI,"^",4)=$P(QUA,"^",1)
S $P(REQE,"^",4)=$P(QUA,"^",1)
QUAX ;--EXIT AND CLEANUP
K X,CPTQUA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBPQUA 1344 printed Dec 13, 2024@02:27:13 Page 2
PXBPQUA ;ISL/JVS,ESW - PROMPT QUANTITY ; 6/18/03 6:34pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112,132,152**;Aug 12, 1996
+2 ;
+3 ;
+4 ;
+5 ;
QUA ;--Quantity
+1 NEW TIMED,DATA,DIC,X
+2 KILL PXBUT,EDATA
+3 IF '$DATA(IOEDEOP)
DO TERM^PXBCC
+4 SET TIMED="I '$T!(DATA[""^"")"
Q ;--SECOND ENTRY POINT
+1 WRITE !!,"How many times was this procedure performed: "_$SELECT($GET(CPTQUA):CPTQUA,1:1)_"//",IOELEOL
READ DATA:DTIME
SET EDATA=DATA
Q1 ;---
+1 XECUTE TIMED
IF $TEST
SET PXBUT=1
DO RSET^PXBDREQ("CPT")
GOTO QUAX
+2 IF DATA?.N1"E".NAP
SET DATA=" "_DATA
+3 IF DATA?24.N
SET DATA=$EXTRACT(DATA,1,24)
+4 ;----SPACE BAR---
+5 IF DATA'=" "
IF DATA'["^"
IF DATA'=""
SET ^DISV(DUZ,"PXBQUA-5")=DATA
+6 IF DATA=" "
IF $DATA(^DISV(DUZ,"PXBQUA-5"))
SET DATA=^DISV(DUZ,"PXBQUA-5")
WRITE DATA
+7 ;-----------------
+8 IF DATA]""
IF DATA'?.3N
if DATA="?"
DO HELP^PXBUTL0("QU1")
if DATA="??"
DO HELP^PXBUTL0("QU2")
GOTO Q
+9 IF DATA'=""
IF DATA<1!(DATA>999)
GOTO Q
+10 IF DATA=""
IF $GET(CPTQUA)
SET DATA=CPTQUA
+11 IF DATA=""
IF '$GET(CPTQUA)
SET DATA=1
+12 IF DATA="?"
DO HELP^PXBUTL0("QU1")
GOTO QUA
+13 IF DATA="??"
DO HELP^PXBUTL0("QU2")
GOTO QUA
QFIN ;--FINISH UP VARIABLES
+1 SET QUA=DATA
+2 NEW VALP
SET VALP=+$PIECE($GET(REQI),U,3)
+3 IF +QUA>1
IF VALP>0
IF $DATA(^IBE(357.69,VALP))
Begin DoDot:1
+4 ;PX*1.0*132,IB*2*257
+5 IF $$GET1^DIQ(357.69,VALP,.06,"I")'="Y"
WRITE !,"Only one E&M code allowed, quantity changed to 1."
SET QUA=1
End DoDot:1
+6 SET $PIECE(REQI,"^",4)=$PIECE(QUA,"^",1)
+7 SET $PIECE(REQE,"^",4)=$PIECE(QUA,"^",1)
QUAX ;--EXIT AND CLEANUP
+1 KILL X,CPTQUA
+2 QUIT
