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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1PXAICPT ;ISL/JVS,ISA/KWP,ESW - SET THE PROCEDURE(CPT) NODES ;8/10/04 4:39pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**19,73,108,112,149,124,164**;Aug 12, 1996
3 ;
4 ;
5 Q
6CPT ;--CREAT PROVIDERS
7 ;
8 ;
9SET ;--SET AND NEW VARIABLES
10 N AFTER0,AFTER1,AFTER12,AFTER801,AFTER802,AFTER811,AFTER812
11 N BEFOR0,BEFOR1,BEFOR12,BEFOR801,BEFOR802,BEFOR811,BEFOR812
12 N PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP
13 ;New Modifier Variables
14 D SET^PXAIMOD
15 K PXAERR
16 S PXAERR(8)=PXAK
17 S PXAERR(7)="PROCEDURE"
18 ;
19 S SUB="" F S SUB=$O(@PXADATA@("PROCEDURE",PXAK,SUB)) Q:SUB="" D
20 .S PXAA(SUB)=$G(@PXADATA@("PROCEDURE",PXAK,SUB))
21 ;Setup PXAA array for Modifiers
22 S SUB=""
23 F S SUB=$O(@PXADATA@("PROCEDURE",PXAK,"MODIFIERS",SUB)) Q:SUB="" D
24 .S PXAA("MODIFIERS",SUB)=""
25 ;
26VAL ;--VALIDATE ENOUGH DATA
27 D VAL^PXAICPTV Q:$G(STOP)
28 ;
29 ;
30SETVARA ;--SET VISIT VARIABLES
31 S $P(AFTER0,"^",1)=$G(PXAA("PROCEDURE"))
32 I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@"
33 S $P(AFTER0,"^",2)=$G(PATIENT)
34 S $P(AFTER0,"^",3)=$G(PXAVISIT)
35 S $P(AFTER0,"^",4)=$G(PXAA("NARRATIVE")) D
36 .I $G(PXAA("NARRATIVE"))']""!($L($G(PXAA("NARRATIVE")))>245) D
37 ..S $P(AFTER0,"^",4)=$P($$CPT^ICPTCOD($G(PXAA("PROCEDURE")),$G(IDATE)),"^",3) ;-- TEXT OF NARRATIVE
38 .I $G(PXAA("NARRATIVE"))]"" S $P(AFTER0,"^",4)=+$$PROVNARR^PXAPI($G(PXAA("NARRATIVE")),9000010.18)
39 I $P(AFTER0,"^",4)<0 D VAL04^PXAICPTV,ERR^PXAI Q:$D(STOP)
40 S $P(AFTER0,"^",5)=$G(PXAA("DIAGNOSIS"))
41 ;PX*1*124 - add dx
42 S $P(AFTER0,"^",9)=$G(PXAA("DIAGNOSIS 2"))
43 S $P(AFTER0,"^",10)=$G(PXAA("DIAGNOSIS 3"))
44 S $P(AFTER0,"^",11)=$G(PXAA("DIAGNOSIS 4"))
45 S $P(AFTER0,"^",12)=$G(PXAA("DIAGNOSIS 5"))
46 S $P(AFTER0,"^",13)=$G(PXAA("DIAGNOSIS 6"))
47 S $P(AFTER0,"^",14)=$G(PXAA("DIAGNOSIS 7"))
48 S $P(AFTER0,"^",15)=$G(PXAA("DIAGNOSIS 8"))
49 I $G(PXAA("QTY"))="" S PXAA("QTY")=1
50 S $P(AFTER0,"^",16)=$G(PXAA("QTY")) I $G(PXAA("QTY"))<1 S PXAA("DELETE")=1
51 S $P(AFTER0,"^",17)=$G(PXAA("ORD REFERENCE"))
52 I $$SWSTAT^IBBAPI() D ;PX*1.0*164
53 . S $P(AFTER0,"^",19)=$G(PXAA("DEPARTMENT"))
54 . I $P(AFTER0,"^",19)="",$G(^AUPNVSIT(PXAVISIT,0)),$P(^AUPNVSIT(PXAVISIT,0),"^",8) S $P(AFTER0,"^",19)=$P($G(^DIC(40.7,$P(^AUPNVSIT(PXAVISIT,0),"^",8),0)),"^",2)
55 ;Set Modifier nodes in AFTER1
56 D SETVARA^PXAIMOD
57 ;
58 S $P(AFTER12,"^",1)=$G(PXAA("EVENT D/T"))
59 ;PX*1*124 - add ord prv
60 S $P(AFTER12,"^",2)=$G(PXAA("ORD PROVIDER"))
61 S $P(AFTER12,"^",4)=$G(PXAA("ENC PROVIDER"))
62 ;PX*1*108 - do not try to file a provider from a "DELETED" cpt
63 I $G(PXAA("ENC PROVIDER"))]"",'$G(PXAA("DELETE")) D
64 .S ^TMP("PXAIADDPRV",$J,$G(PXAA("ENC PROVIDER")))=""
65 ;PX*1*124 - do not try to file a provider from a "DELETED" cpt
66 I $G(PXAA("ORD PROVIDER"))]"",'$G(PXAA("DELETE")) D
67 .S ^TMP("PXAIADDPRV",$J,$G(PXAA("ORD PROVIDER")))=""
68 ;
69 S $P(AFTER802,"^",1)=$G(PXAA("CATEGORY"))
70 I $G(PXAA("CATEGORY"))]"" S $P(AFTER802,"^",1)=+$$PROVNARR^PXAPI($G(PXAA("CATEGORY")),9000010.18)
71 I $P(AFTER802,"^",1)<0 D VAL45^PXAICPTV,ERR^PXAI Q:$D(STOP)
72 S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
73 ;
74 ;
75 ;
76 ;--PACKAGE AND SOURCE
77 ;
78 S $P(AFTER812,"^",2)=$G(PXAPKG)
79 S $P(AFTER812,"^",3)=$G(PXASOURC)
80 ;
81SETPXKA ;--SET PXK ARRAY AFTER
82 S ^TMP("PXK",$J,"CPT",PXAK,0,"AFTER")=AFTER0
83 ;Set ^TMP("PXK",$J,"CPT",PXAK,1,ien,"AFTER")=MODIEN
84 D SETPXKA^PXAIMOD
85 S ^TMP("PXK",$J,"CPT",PXAK,12,"AFTER")=AFTER12
86 S ^TMP("PXK",$J,"CPT",PXAK,802,"AFTER")=AFTER802
87 S ^TMP("PXK",$J,"CPT",PXAK,811,"AFTER")=AFTER811
88 S ^TMP("PXK",$J,"CPT",PXAK,812,"AFTER")=AFTER812
89 ;
90SETVARB ;--SET VARIABLES BEFORE
91 D
92 .N PXBKY,PXBSAM,PXBSKY,PXBCNT,PXI,PRV,ITEM
93 .D CPT^PXBGCPT(PXAVISIT)
94 .S PXAAX("PROCEDURE")=$P($G(^ICPT($G(PXAA("PROCEDURE")),0)),"^",1)
95 .I $G(PXAA("DELETE"))=1 S PXAAX("PROCEDURE")=$P($G(^ICPT($G(PXAA("PROCEDURE")),0)),"^",1)
96 .S ITEM=""
97 .I PXBCNT>0,$G(PXAAX("PROCEDURE"))]"" S ITEM=$O(PXBKY(PXAAX("PROCEDURE"),0))
98 .I ITEM]"" D
99 ..;--LOOK UP USING CPT AND PROVIDER
100 ..S PXI="" F S PXI=$O(PXBKY(PXAAX("PROCEDURE"),PXI)) Q:PXI="" D
101 ...I $D(^IBE(357.69,PXAAX("PROCEDURE"))) D Q ;DBIA #: 1906
102 ....S (^TMP("PXK",$J,"CPT",PXAK,"IEN"),IENB)=$O(PXBSKY(PXI,0))
103 ...I $G(PXAA("ENC PROVIDER")) D Q
104 ....S PRV=$P(^VA(200,$G(PXAA("ENC PROVIDER")),0),"^",1)
105 ....I $P($G(PXBKY(PXAAX("PROCEDURE"),PXI)),"^",3)=PRV D
106 .....S (^TMP("PXK",$J,"CPT",PXAK,"IEN"),IENB)=$O(PXBSKY(PXI,0))
107 I $G(IENB) D
108 .F PIECE=0,12,802,811,812 S ^TMP("PXK",$J,"CPT",PXAK,PIECE,"BEFORE")=$G(^AUPNVCPT(IENB,PIECE))
109 .;Set ^TMP("PXK",$J,"CPT",PXAK,1,ien,"BEFORE")=MODIEN
110 .D SETVARB^PXAIMOD
111 E D
112 .S (BEFOR0,BEFOR12,BEFOR802,BEFOR811,BEFOR812)=""
113 .;
114SETPXKB .;--SET PXK ARRAY BEFORE
115 .S ^TMP("PXK",$J,"CPT",PXAK,0,"BEFORE")=BEFOR0
116 .;Set ^TMP("PXK",$J,"CPT",PXAK,1,ien,"BEFORE")=MODIEN
117 .D SETPXKB^PXAIMOD
118 .S ^TMP("PXK",$J,"CPT",PXAK,12,"BEFORE")=BEFOR12
119 .S ^TMP("PXK",$J,"CPT",PXAK,802,"BEFORE")=BEFOR802
120 .S ^TMP("PXK",$J,"CPT",PXAK,811,"BEFORE")=BEFOR811
121 .S ^TMP("PXK",$J,"CPT",PXAK,812,"BEFORE")=BEFOR812
122 .S ^TMP("PXK",$J,"CPT",PXAK,"IEN")=""
123 ;
124MISC ;--MISCELLANEOUS NODE
125 ;
126 Q
Note: See TracBrowser for help on using the repository browser.