1 | PXAICPT ;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
|
---|
6 | CPT ;--CREAT PROVIDERS
|
---|
7 | ;
|
---|
8 | ;
|
---|
9 | SET ;--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 | ;
|
---|
26 | VAL ;--VALIDATE ENOUGH DATA
|
---|
27 | D VAL^PXAICPTV Q:$G(STOP)
|
---|
28 | ;
|
---|
29 | ;
|
---|
30 | SETVARA ;--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 | ;
|
---|
81 | SETPXKA ;--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 | ;
|
---|
90 | SETVARB ;--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 | .;
|
---|
114 | SETPXKB .;--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 | ;
|
---|
124 | MISC ;--MISCELLANEOUS NODE
|
---|
125 | ;
|
---|
126 | Q
|
---|