source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCAPOV.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1PXCAPOV ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface into PCE's PXK format for POV ;3/20/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**24,27,33,121,130,124**;Aug 12, 1996
3 Q
4 ; Variables
5 ; PXCADIAG Copy of a Diagnosis node of the PXCA array
6 ; PXCAPRV Pointer to the provider (200)
7 ; ; PXCANPOV Count of the number of POVs
8 ; PXCANUMB Count of the number if POVs
9 ; PXCAINDX Count of the number of Diagnoses for one provider
10 ;
11DIAG(PXCA,PXCABULD,PXCAERRS) ;Validation routine for POV
12 N PXCADIAG,PXCAPRV,PXCAINDX
13 S PXCAPRV=""
14 F S PXCAPRV=$O(PXCA("DIAGNOSIS",PXCAPRV)) Q:PXCAPRV']"" D
15 . I PXCAPRV>0 D
16 .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
17 .. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
18 . S PXCAINDX=0
19 . F S PXCAINDX=$O(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
20 .. S PXCADIAG=$G(PXCA("DIAGNOSIS",PXCAPRV,PXCAINDX))
21 .. I PXCADIAG="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,0)="DIAGNOSIS data missing" Q
22 .. S PXCANPOV=PXCANPOV+1
23 .. N PXCAITEM,PXCAITM2,PXCAPNAR,PXCANARC,PXCACLEX
24 .. ;
25 .. S PXCAITEM=$P(PXCADIAG,"^",1)
26 .. D
27 ... ;N DIC,DR,DA,DIQ,PXCADIQ1
28 ... ;S DIC=80
29 ... ;S DR=".01;102"
30 ... ;S DA=$S(PXCAITEM'="":PXCAITEM,1:-1)
31 ... ;S DIQ="PXCADIQ1("
32 ... ;S DIQ(0)="I"
33 ... ;D EN^DIQ1
34 ... ;I $G(PXCADIQ1(80,DA,.01,"I"))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
35 ... ;E I $G(PXCADIQ1(80,DA,102,"I")),PXCADIQ1(80,DA,102,"I")'>+PXCADT S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
36 ... N ICDSTR,ICDCN,ICDID
37 ... S ICDSTR=$$ICDDX^ICDCODE($S(PXCAITEM'="":PXCAITEM,1:-1),+PXCADT)
38 ... S ICDCN=$P(ICDSTR,"^",2)
39 ... S ICDID=$P(ICDSTR,"^",12)
40 ... I +ICDSTR=-1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code not in file 80^"_PXCAITEM
41 ... E I '$P(ICDSTR,"^",10) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,1)="ICD9 Code is INACTIVE^"_PXCAITEM
42 ...;
43 .. S PXCAITEM=$P(PXCADIAG,"^",2)
44 .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="Diagnosis specification code must be P|S^"_PXCAITEM
45 .. E I PXCAITEM="P" D
46 ... I 'PXCAPDX S PXCAPDX=$P(PXCADIAG,"^",1)
47 ... E I $P($G(^PX(815,1,"DI")),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis for this encounter^"_PXCAITEM
48 ... E D
49 .... S PXCA("WARNING","DIAGNOSIS",PXCAPRV,PXCAINDX,2)="There is already a Primary Diagnosis. This one is changed to Secondary^"_PXCAITEM
50 .... S $P(PXCADIAG,"^",2)="S"
51 .. S PXCAITEM=$P(PXCADIAG,"^",3)
52 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,3)="SC flag bad^"_PXCAITEM
53 .. S PXCAITEM=$P(PXCADIAG,"^",4)
54 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,4)="AO flag bad^"_PXCAITEM
55 .. S PXCAITEM=$P(PXCADIAG,"^",5)
56 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,5)="IR flag bad^"_PXCAITEM
57 .. S PXCAITEM=$P(PXCADIAG,"^",6)
58 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,6)="EC flag bad^"_PXCAITEM
59 .. S PXCAITEM=$P(PXCADIAG,"^",11)
60 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,11)="MST flag bad^"_PXCAITEM
61 .. S PXCAITEM=$P(PXCADIAG,"^",12)
62 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,12)="HNC flag bad^"_PXCAITEM
63 .. S PXCAITEM=$P(PXCADIAG,"^",13)
64 .. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,13)="CV flag bad^"_PXCAITEM ;CV
65 .. S PXCAITEM=$P(PXCADIAG,"^",14)
66 .. I '(PXCAITEM="R"!(PXCAITEM="O")!(PXCAITEM="RO")!(PXCAITEM="")) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,14)="Ordering/Resulting field bad^"_PXCAITEM
67 .. S PXCAITEM=$P(PXCADIAG,"^",7)
68 .. I PXCAITEM]"" D
69 ... I $G(^AUPNPROB(PXCAITEM,0))="" S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem not in file 9000011^"_PXCAITEM
70 ... E I PXCAPAT'=$P($G(^AUPNPROB(PXCAITEM,0)),"^",2) S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,7)="Problem in file 9000011 is for a different Patient^"_PXCAITEM
71 .. ;
72 .. ;Clinical Lexicon Term
73 .. S PXCAITEM=$P(PXCADIAG,"^",10)
74 .. I PXCAITEM]"" D
75 ... I $D(^LEX(757.01)) D
76 .... I $D(^LEX(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility term is not in file 757.01^"_PXCAITEM
77 .... E S PXCACLEX=PXCAITEM
78 ... E I $D(^GMP(757.01)) D
79 .... I $D(^GMP(757.01,PXCAITEM,0))#2'=1 S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Clinical Lexicon Utility term is not in file 757.01^"_PXCAITEM
80 .... E S PXCACLEX=PXCAITEM
81 ... E S PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX,10)="Lexicon Utility is not installed^"_PXCAITEM
82 .. ;
83 .. D PART1^PXCAPOV1
84 .. ;
85 .. I PXCABULD&'$D(PXCA("ERROR","DIAGNOSIS",PXCAPRV,PXCAINDX))!PXCAERRS D POV^PXCADX(PXCADIAG,PXCANPOV,PXCAPRV,PXCAERRS)
86 Q
87 ;
88ANOTHPOV(PXCAAPOV) ;
89 ;Add the diagnosis to V POV if they are not there.
90 ;Quit if the provider subscript is zero
91 ; Variables
92 ; PXCAAPOV Pointer to the DIAGNOSIS (80)
93 ; PXCAINDX Subscript of the diagnosis in the temp array used to
94 ; look to see if the above diagnosis is already know.
95 Q:PXCAAPOV'>0
96 N PXCAINDX
97 ;See if this diagnosis is in the ^TMP(PXCAGLB,$J,
98 F PXCAINDX=1:1:PXCANPOV I PXCAAPOV=+$G(^TMP(PXCAGLB,$J,"POV",PXCAINDX,0,"AFTER")) S PXCAINDX=0 Q
99 Q:PXCAINDX'>0
100 S PXCAINDX=0
101 ;See if this diagnosis is already in V POV for this Encounter
102 F S PXCAINDX=$O(^AUPNVPOV("AD",PXCAVSIT,PXCAAPOV)) Q:PXCAINDX'>0 I PXCAAPOV=$P(^AUPNVPOV(PXCAINDX,0),"^",1) Q
103 Q:PXCAINDX>0
104 S PXCANPOV=PXCANPOV+1
105 S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,"IEN")=""
106 S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,0,"BEFORE")=""
107 S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,0,"AFTER")=PXCAAPOV_"^"_PXCAPAT_"^"_PXCAVSIT_"^^^^^^^^^S"
108 S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,812,"BEFORE")=""
109 S ^TMP(PXCAGLB,$J,"POV",PXCANPOV,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
110 Q
111 ;
Note: See TracBrowser for help on using the repository browser.