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

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PXBDREQ ;ISL/JVS - DISPLAY REQUESTS ;6/17/03 10:29
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,124**;Aug 12, 1996
3 ;
4 ; Variable list
5 ; These two variables represent the data that has been selected
6 ; to be saved in the v files by the user
7 ;
8 ; REQ*=PROVIDER^PRIMARY^CPT^QUANTITY^POV^PRIMARY
9 ; REQI=Internal Values
10 ; REQE=External Values
11 ;
12REQ(NO) ;--Display the REQUESTED Data
13 N ENTRY,VAR
14 S VAR="N"_NO D @VAR
15 Q
16N4 ;---Fourth Method--for the CPT promts
17 W !,"PROVIDER: ...Enter the provider associated with the CPT'S....."
18 D UNDON^PXBCC
19 W !,?5,"CPT: "
20 F W $C(32) Q:$X=(IOM-(4))
21 W !
22 D UNDOFF^PXBCC
23 Q
24N5 ;---Fifth Method--for the PROVIDER prompts
25 W !,"PROVIDER: ...Select a Provider....."
26 D UNDON^PXBCC
27 W !
28 F W $C(32) Q:$X=(IOM-(4))
29 W !
30 D UNDOFF^PXBCC
31 Q
32 ;
33N6 ;---Sixth Method--for the POV(DIAGNOSIS) prompts
34 W !,"ICD CODE: ...Select a DIAGNOSIS Code....."
35 D UNDON^PXBCC
36 W !
37 F W $C(32) Q:$X=(IOM-(4))
38 W !
39 D UNDOFF^PXBCC
40 Q
41N7 ;---SEVENTH Method--for the STOP CODES prompts
42 W !,"STOP CODE: ...Select an AMIS STOP Code....."
43 D UNDON^PXBCC
44 W !
45 F W $C(32) Q:$X=(IOM-(4))
46 W !
47 D UNDOFF^PXBCC
48 Q
49N8 ;---EIGHTH Method--for the ENCOUNTERS prompts
50 W !,"ENCOUNTERS: ...Select an ENCOUNTER ....."
51 D UNDON^PXBCC
52 W !
53 F W $C(32) Q:$X=(IOM-(4))
54 W !
55 D UNDOFF^PXBCC
56 Q
57 ;
58PRINT(NO) ;--Display the requested information
59 N ENTRY,VAR
60 S VAR="ZP"_NO D @VAR
61 Q
62ZP1 ;--PROVIDER AND PRIMARY
63 I '$D(REQE) Q
64 D LOC^PXBCC(1,10) W $P(REQE,"^",1)_" "_$P(REQE,"^",2),IOELEOL
65 Q
66ZP2 ;--CPT PROCEDURE AND DESCRIPTION
67 I '$D(REQE) Q
68 S ENTRY=$P(REQE,"^",3) I ENTRY]"" D RREVH^PXBCC(1,10,ENTRY)
69 Q
70ZP3 ;--QUANTITY OF PROCEDURES
71 I '$D(REQE) Q
72 S ENTRY=$P(REQE,"^",4) I ENTRY]"" D RREV^PXBCC(1,45,ENTRY)
73 Q
74ZP4 ;--DIAGNOSIS
75 I '$D(REQE) Q
76 D LOC^PXBCC(1,10) W $P(REQE,"^",5)_" "_$P(REQE,"^",6),IOELEOL
77 Q
78 ;
79ZP5 ;--STOP CODE
80 I '$D(REQE) Q
81 S ENTRY=$P(REQE,"^",10) I ENTRY]"" D RREV^PXBCC(0,10,ENTRY)
82 Q
83 ;
84ZP6 ;PX124
85ZP7 ;
86ZP8 ;
87ZP9 ;
88ZP10 ;
89ZP11 ;
90ZP12 ;
91ZP13 ;
92ZP14 ;
93ZP15 ;
94 I $D(REQE) D LOC^PXBCC(1,0) W "DIAGNOSIS: ",$P(REQE,"^",NO+6),IOELEOL
95 Q
96 ;
97RSET(CATEGORY) ; Reset the data in the REQ,REQI and REQE variables
98 ; CATEGORY IS EQUAL TO FILE NEUMONICS (eg. CPT,POV,PRV)
99 D @CATEGORY
100 Q
101CPT ;CPT CODES
102 N PX124
103 S $P(REQI,"^",3)="",$P(REQE,"^",3)="",$P(REQI,"^",8)=""
104 S $P(REQI,"^",4)="",$P(REQE,"^",4)=""
105 F PX124=12:1:22 S $P(REQI,"^",PX124)="",$P(REQE,"^",PX124)=""
106 K REQ
107 Q
108PRV ;PROVIDER
109 S $P(REQI,"^",1)="",$P(REQE,"^",1)="",$P(REQI,"^",7)=""
110 S $P(REQI,"^",2)="",$P(REQE,"^",2)=""
111 Q
112POV ;PURPOSE OF VISIT
113 S $P(REQI,"^",5)="",$P(REQE,"^",5)="",$P(REQI,"^",9)=""
114 S $P(REQI,"^",6)="",$P(REQE,"^",6)=""
115 Q
116STP ;STOPCODES
117 S $P(REQI,"^",10)="",$P(REQE,"^",10)=""
118 S $P(REQI,"^",11)="",$P(REQE,"^",11)=""
119 Q
120 ;
Note: See TracBrowser for help on using the repository browser.