PXBPQUA.m

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 ---PXBPQUA   1344     printed  Apr 09, 2024@21:32:50                                                                                                                                                                                                     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