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

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

initial load of WorldVistAEHR

File size: 6.6 KB
RevLine 
[613]1PXCACPT ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;5/24/04 3:51pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33,73,121,124**;Aug 12, 1996
3 Q
4 ; Variables
5 ; PXCAPROC Copy of a Procedure node of the PXCA array
6 ; PXCAPRV Pointer to the provider (200)
7 ; PXCANUMB Count of the number of CPTs and treatments
8 ; PXCAINDX Count of the number of procedures for one provider
9 ; PXCAPNAR Pointer to the provider narrative (9999999.27)
10 ; PXCATRT Pointer to the Treatment file (9999999.17)
11 ;
12PROC(PXCA,PXCABULD,PXCAERRS,PXCAEVAL) ;
13 I '$D(PXCA("PROCEDURE")),'PXCAEVAL,$P($G(^PX(815,1,"DI")),"^",1),'$D(^AUPNVCPT("AD",+PXCAVSIT)) S PXCA("WARNING","PROCEDURE",0,0,0)="PROCEDURE data missing" Q
14 N PXCAPROC,PXCAPRV,PXCANUMB,PXCAINDX,PXCAITEM,PXCALEN
15 N PXCAPNAR,PXCANARC
16 S PXCAPRV=""
17 S PXCANUMB=1
18 F S PXCAPRV=$O(PXCA("PROCEDURE",PXCAPRV)) Q:PXCAPRV']"" D
19 . I PXCAPRV>0 D
20 .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROCEDURE",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
21 . I '$T&PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
22 . S PXCAINDX=0
23 . F S PXCAINDX=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
24 .. N PXCATRT
25 .. S PXCANUMB=PXCANUMB+1
26 .. S PXCAPROC=$G(PXCA("PROCEDURE",PXCAPRV,PXCAINDX))
27 .. I PXCAPROC="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,0)="PROCEDURE data missing" Q
28 .. S PXCAITEM=$P(PXCAPROC,U,1)
29 .. I PXCAITEM]"" D
30 ... S D=$G(^ICPT(+PXCAITEM,0))
31 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code not in File 81^"_PXCAITEM
32 ... E I '(+$$CPTSCREN^PXBUTL(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code is INACTIVE^"_PXCAITEM
33 .. E D
34 ... S PXCATRT=$O(^AUTTTRT("B",+$P(PXCAPROC,"^",6),""))
35 ... S:PXCATRT="" PXCATRT=$O(^AUTTTRT("B","OTHER",""))
36 ... I 'PXCATRT S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to treatment term^"_$P(PXCAPROC,"^",6)
37 .. S PXCAITEM=$P(PXCAPROC,U,2)
38 .. I PXCAITEM="" S PXCAITEM=1,$P(PXCAPROC,U,2)=PXCAITEM
39 .. I PXCAITEM'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,2)="CPT Quantity must be > 0^"_PXCAITEM
40 .. S PXCAITEM=$P(PXCAPROC,U,3)
41 .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,3)="Specification code must be P|S^"_PXCAITEM
42 .. S PXCAITEM=+$P(PXCAPROC,U,5)
43 .. I PXCAITEM D
44 ... ; S D=$G(^ICD9(PXCAITEM,0))
45 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
46 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,5)="Associated Primary Diagnosis ICD9 Code not in File 81^"_PXCAITEM
47 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="ICD code is INACTIVE^"_PXCAITEM
48 .. S PXCAITEM=+$P(PXCAPROC,U,8)
49 .. I PXCAITEM D
50 ... ; S D=$G(^ICD9(PXCAITEM,0))
51 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
52 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,8)="Associated Diagnosis 2 ICD9 Code not in file 80^"_PXCAITEM
53 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,8)="Associated Diagnosis 2 ICD9 Code is INACTIVE^"_PXCAITEM
54 .. S PXCAITEM=+$P(PXCAPROC,U,9)
55 .. I PXCAITEM D
56 ... ; S D=$G(^ICD9(PXCAITEM,0))
57 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
58 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,9)="Associated Diagnosis 3 ICD9 Code not in file 80^"_PXCAITEM
59 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,9)="Associated Diagnosis 3 ICD9 Code is INACTIVE^"_PXCAITEM
60 .. S PXCAITEM=+$P(PXCAPROC,U,10)
61 .. I PXCAITEM D
62 ... ; S D=$G(^ICD9(PXCAITEM,0))
63 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
64 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,10)="Associated Diagnosis 4 ICD9 Code not in file 80^"_PXCAITEM
65 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,10)="Associated Diagnosis 4 ICD9 Code is INACTIVE^"_PXCAITEM
66 .. S PXCAITEM=+$P(PXCAPROC,U,11)
67 .. I PXCAITEM D
68 ... ; S D=$G(^ICD9(PXCAITEM,0))
69 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
70 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,11)="Associated Diagnosis 5 ICD9 Code not in file 80^"_PXCAITEM
71 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,11)="Associated Diagnosis 5 ICD9 Code is INACTIVE^"_PXCAITEM
72 .. S PXCAITEM=+$P(PXCAPROC,U,12)
73 .. I PXCAITEM D
74 ... ; S D=$G(^ICD9(PXCAITEM,0))
75 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
76 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,12)="Associated Diagnosis 6 ICD9 Code not in file 80^"_PXCAITEM
77 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,12)="Associated Diagnosis 6 ICD9 Code is INACTIVE^"_PXCAITEM
78 .. S PXCAITEM=+$P(PXCAPROC,U,13)
79 .. I PXCAITEM D
80 ... ; S D=$G(^ICD9(PXCAITEM,0))
81 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
82 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,13)="Associated Diagnosis 7 ICD9 Code not in file 80^"_PXCAITEM
83 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,13)="Associated Diagnosis 7 ICD9 Code is INACTIVE^"_PXCAITEM
84 .. S PXCAITEM=+$P(PXCAPROC,U,14)
85 .. I PXCAITEM D
86 ... ; S D=$G(^ICD9(PXCAITEM,0))
87 ... S D=$$ICDDX^ICDCODE(PXCAITEM,PXCADT)
88 ... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,14)="Associated Diagnosis 8 ICD9 Code not in file 80^"_PXCAITEM
89 ... E I '(+$$ICDDX^ICDCODE(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,14)="Associated Diagnosis 8 ICD9 Code is INACTIVE^"_PXCAITEM
90 .. S PXCAITEM=$P(PXCAPROC,U,6),PXCALEN=$L(PXCAITEM)
91 .. I PXCALEN<2!(PXCALEN>80) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Provider's PROCEDURE term must be 2-80 Characters^"_PXCAITEM
92 .. E D
93 ... S PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,$S($P(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
94 ... I PXCAPNAR'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to Provider's PROCEDURE term^"_$P(PXCAPROC,"^",6) Q:'PXCAERRS
95 ... S $P(PXCAPROC,"^",6)=PXCAPNAR
96 .. S PXCAITEM=$P(PXCAPROC,U,7),PXCALEN=$L(PXCAITEM)
97 .. I PXCALEN>0 D
98 ... I PXCALEN<2!(PXCALEN>80) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Provider's PROCEDURE grouper must be 2-80 Characters^"_PXCAITEM
99 ... E D
100 .... S PXCANARC=+$$PROVNARR^PXAPI(PXCAITEM,$S($P(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
101 .... I PXCANARC'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Could not get pointer to Provider's PROCEDURE grouper^"_PXCAITEM
102 .... E S $P(PXCAPROC,"^",7)=PXCANARC
103 .. I PXCABULD&'$D(PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX))!PXCAERRS D
104 ... I $P(PXCAPROC,"^",1)]"" D
105 .... D CPT^PXCACPT1(.PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS)
106 ... E D TRT^PXCATRT(PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS,PXCATRT)
107 Q
108 ;
Note: See TracBrowser for help on using the repository browser.