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

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

initial load of WorldVistAEHR
File size: 3.8 KB
RevLine 
[613]1PXBMCPT ;ISL/JVS,ESW - MAIN ROUTINE CPT CODES ; 12/5/02 11:36am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
3 ;
4 W !,"This is not the entry into this routine" Q
5 ;
6 ; VARABLE LIST
7 ;
8 ;
9CPT(PXBVST) ;---Real entry point
10 Q:'$D(^AUPNVSIT(PXBVST))
11 D CPT^PXBMCPT2(PXBVST) Q
12 S TEST=1
13 ; PXBVST = Appointment-Encounter Visit IEN
14 ; PXBDPRV = Default Provider for clinic appointment IEN
15 ;--Set up
16 N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR
17 N PXBUT,FPRI,ENTRY,PXBSAVE,NAME,VAR,DOUBLEQQ,CPTQUA,PXBPRV,ERROR
18 N REQI,REQE,DATA,PROMPT,FIRSTCPT,KFIRST,FROM,IDATE,%,CYCL
19 N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,PATIENT
20 N FROM,NOREV
21 S (REQE,REQI)=""
22 S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22),PROMPT="CPT"
23 ;--KILL OF THE TMP GLOGALS IN ALL PROMPTS
24 S ^TMP("PXBDCPT",$J,"START")=0,FIRST=1,FIRSTCPT=1,PXBEXIT=1
25 ;
26P ;--Obtain the correct provider
27 I $G(DOUBLEQQ) S FIRST=1
28 D TERM^PXBCC
29 D HDR^PXBUTL(PXBVST,1),REQ^PXBDREQ(4)
30 D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
31 I $G(TEST)=1 S FROM="CPT" D EN0^PXBDPRV K FROM
32 I $G(TEST)=2 D CPT^PXBGCPT(PXBVST)
33 I $G(TEST)=2 D EN0^PXBDCPT
34R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
35 K ERROR S FROM="CPT" D PRV^PXBPPRV W:$D(CYCL) IOSC K FROM G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R K CYCL
36 W IOEDEOP
37 I $G(DOUBLEQQ)=1,'$P(REQI,"^",1) G P
38 I DATA["^P" D RSET^PXBDREQ("PRV") G P
39 I $G(PXBUT)=1,'$D(FIRST) G CPTXIT
40 I $G(PXBUT)=1,$D(LEAVE) G CPTXIT
41 K FIRST
42 ;
43 ;--Prompt for Primary or Secondary Provider
44 S PROMPT="CPT^PRV" D PRI^PXBPPRV1 S PROMPT="CPT"
45 I $D(DIRUT) G P
46 ;
47 ;--Display the Requested Provider
48 D PRINT^PXBDREQ(1)
49 D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
50 ;
51 ;--File the Provider data into the V files
52 D EN1^PXKMAIN
53 ;
54C ;--Display the CPT codes
55 D LOC^PXBCC(3,1) W IOEDEOP
56 D CPT^PXBGCPT(PXBVST)
57 D EN0^PXBDCPT
58R2 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
59 K ERROR D CPT^PXBPCPT G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R2 W IOEDEOP
60 I DATA=""!(DATA["^P") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
61 I DATA["^C" D RSET^PXBDREQ("CPT") G C
62 I DATA=""!(DATA["^") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
63 ;
64 ;--Display the requested CPT code
65 D PRINT^PXBDREQ(2)
66 ;
67Q ;--Prompt of the QUANTITY of the CPT code
68 D WIN17^PXBCC(PXBCNT)
69 S PROMPT="CPT^QUA" D QUA^PXBPQUA S PROMPT="CPT"
70 I EDATA["^C" D RSET^PXBDREQ("CPT") G C
71 I EDATA["^P" D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
72 ;
73 ;--Create The ^TMP("PXK", ARRAY
74 D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
75 ;--File the data into the V files
76 D EN1^PXKMAIN
77 D RSET^PXBDREQ("CPT")
78 G C
79 ;
80CPTXIT ;----EXIT AND CLEAN UP
81 D KILL^PXBUTL3
82 D PRIM^PXBUTL
83 D FULL0^PXBCC
84 D CLEAR1^PXBCC
85 K PXBKY,PXBSAM,PXBSKY,PXBVST
86 ;
87 ;----Do the EVENT to the Protocol
88 K ^TMP("PXBDCPT",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J)
89 K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
90 Q
91 ;
92TEST3 ;---THIRD SERERIO FOR PROMPTING FOR CPT'S
93 I $G(DOUBLEQQ) S FIRST=1
94 D TERM^PXBCC
95 D HDR^PXBUTL(PXBVST,1),REQ^PXBDREQ(4)
96 D TEST3C
97 D TEST3Q
98TEST3C ;--Display the CPT codes
99 D LOC^PXBCC(3,1) W IOEDEOP
100 D CPT^PXBGCPT(PXBVST)
101 D EN0^PXBDCPT
102R23 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
103 K ERROR D CPT^PXBPCPT G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R2 W IOEDEOP
104 I DATA=""!(DATA["^P") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
105 I DATA["^C" D RSET^PXBDREQ("CPT") G C
106 I DATA=""!(DATA["^") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
107 ;
108 ;--Display the requested CPT code
109 D PRINT^PXBDREQ(2)
110 Q
111TEST3Q ;--Prompt of the QUANTITY of the CPT code
112 D WIN17^PXBCC(PXBCNT)
113 S PROMPT="CPT^QUA" D QUA^PXBPQUA S PROMPT="CPT"
114 I EDATA["^C" D RSET^PXBDREQ("CPT") G C
115 I EDATA["^P" D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
116 ;
117 ;--Create The ^TMP("PXK", ARRAY
118 D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
119 ;--File the data into the V files
120 D EN1^PXKMAIN
121 D RSET^PXBDREQ("CPT")
122 G C
123 Q
Note: See TracBrowser for help on using the repository browser.