source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBPQUA.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1PXBPQUA ;ISL/JVS,ESW - PROMPT QUANTITY ; 6/18/03 6:34pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,112,132,152**;Aug 12, 1996
3 ;
4 ;
5 ;
6 ;
7QUA ;--Quantity
8 N TIMED,DATA,DIC,X
9 K PXBUT,EDATA
10 I '$D(IOEDEOP) D TERM^PXBCC
11 S TIMED="I '$T!(DATA[""^"")"
12Q ;--SECOND ENTRY POINT
13 W !!,"How many times was this procedure performed: "_$S($G(CPTQUA):CPTQUA,1:1)_"//",IOELEOL R DATA:DTIME S EDATA=DATA
14Q1 ;---
15 X TIMED I S PXBUT=1 D RSET^PXBDREQ("CPT") G QUAX
16 I DATA?.N1"E".NAP S DATA=" "_DATA
17 I DATA?24.N S DATA=$E(DATA,1,24)
18 ;----SPACE BAR---
19 I DATA'=" ",DATA'["^",DATA'="" S ^DISV(DUZ,"PXBQUA-5")=DATA
20 I DATA=" ",$D(^DISV(DUZ,"PXBQUA-5")) S DATA=^DISV(DUZ,"PXBQUA-5") W DATA
21 ;-----------------
22 I DATA]"",DATA'?.3N D:DATA="?" HELP^PXBUTL0("QU1") D:DATA="??" HELP^PXBUTL0("QU2") G Q
23 I DATA'="",DATA<1!(DATA>999) G Q
24 I DATA="",$G(CPTQUA) S DATA=CPTQUA
25 I DATA="",'$G(CPTQUA) S DATA=1
26 I DATA="?" D HELP^PXBUTL0("QU1") G QUA
27 I DATA="??" D HELP^PXBUTL0("QU2") G QUA
28QFIN ;--FINISH UP VARIABLES
29 S QUA=DATA
30 N VALP S VALP=+$P($G(REQI),U,3)
31 I +QUA>1,VALP>0,$D(^IBE(357.69,VALP)) D
32 .;PX*1.0*132,IB*2*257
33 .I $$GET1^DIQ(357.69,VALP,.06,"I")'="Y" W !,"Only one E&M code allowed, quantity changed to 1." S QUA=1
34 S $P(REQI,"^",4)=$P(QUA,"^",1)
35 S $P(REQE,"^",4)=$P(QUA,"^",1)
36QUAX ;--EXIT AND CLEANUP
37 K X,CPTQUA
38 Q
Note: See TracBrowser for help on using the repository browser.