source: FOIAVistA/trunk/r/SURGERY-SR/SROPCE.m@ 1452

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1SROPCE ;BIR/ADM - PCE updates ;[ 10/17/01 9:28 AM ]
2 ;;3.0;Surgery;**58,62,69,88,105,119**;24 Jun 93
3 ;
4 ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
5 ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
6 ;
7 Q
8NITE ; entry for nightly update of PCE with surgery & non-OR procedure data
9 N DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SRDXN,SREC,SRHNC,SRIR,SRCV,SRK,SRLOC,SRMST,SRNAR,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRTN,SRV,SRVSIT,SRX
10 N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRADX,SRADX1,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRODIAG,SRDXF
11 K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC Q:Y=-1 S SRPKG=+Y
12 S SRS="SURGERY DATA",SRFILE=0 K ^TMP("SRPXAPI",$J)
13 S SRTN=0 F S SRTN=$O(^SRF("APCE",SRTN)) Q:'SRTN D UTIL K:SRK ^SRF("APCE",SRTN) I 'SRK D PCE
14 Q
15DEL ; delete data from the Visit file and V files
16 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR
17 S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT
18 Q
19UTIL ; set procedure variables
20 N SRDIV,SRSITE,SRSR
21 S SRSR="",SRK=0,SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRSITE=$O(^SRO(133,"B",SRDIV,0)),X=^SRO(133,SRSITE,0),SRUP=$P(X,"^",15),SRSR=$P(X,"^",19) I SRUP=""!(SRUP="N") S SRK=1 Q
22 I 'SRFILE S SRX=$G(^SRF("APCE",SRTN)) I SRX S SRVSIT=SRX D DEL I '$D(^SRF(SRTN,0)) S SRK=1 Q
23 S SR(0)=$G(^SRF(SRTN,0)) I SR(0)=""!$P($G(^SRF(SRTN,30)),"^") S SRK=1 Q
24 S DFN=$P(SR(0),"^")
25 S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0),SRCPT=$P(^SRF(SRTN,"OP"),"^",2) I 'SRCPT S SRK=1 Q
26 S SRX=0 F S SRX=$O(^SRF(SRTN,13,SRX)) Q:'SRX I '$P($G(^SRF(SRTN,13,SRX,2)),"^") S SRK=1 Q
27 Q:SRK S SRDIAG=$P($G(^SRF(SRTN,34)),"^",2) I 'SRDIAG S SRK=1 Q
28 S SRODIAG=$P($G(^SRF(SRTN,34)),"^",3)
29 S SRDXF=$S(SRODIAG=SRDIAG:1,1:0)
30 I 'SRNON D I SRK Q
31 .S SRX=$P(SR(0),"^",21) I SRX S SRLOC=SRX
32 .I 'SRX S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",5) I SRX S SRLOC=SRX
33 .I 'SRX S SRX=$P(SR(0),"^",2) S:SRX SRLOC=$P(^SRS(SRX,0),"^") I 'SRX S SRK=1 Q
34 .S SRX=$G(^SRF(SRTN,.2)),SRCHK=$P(SRX,"^",12) I 'SRCHK S SRK=1 Q
35 .S SRDATE=$P(SRX,"^",10) I 'SRDATE S SRK=1 Q
36 .S SRX=$G(^SRF(SRTN,.1)),SRPROV=$P(SRX,"^",4),SRATT=$P(SRX,"^",13) I 'SRPROV S SRK=1 Q
37 .I SRSR'=0,'SRATT S SRK=1 Q
38 I SRNON D I SRK Q
39 .S SRLOC=$P(SR(0),"^",21)
40 .S SRX=^SRF(SRTN,"NON"),SRCHK=$P(SRX,"^",5) I 'SRCHK S SRK=1 Q
41 .S SRDATE=$P(SRX,"^",4) I 'SRDATE S SRK=1 Q
42 .I 'SRLOC S SRLOC=$P(SRX,"^",2) I 'SRLOC S SRK=1 Q
43 .S SRPROV=$P(SRX,"^",6),SRATT=$P(SRX,"^",7) I 'SRPROV S SRK=1
44 .I SRSR'=0,'SRATT S SRK=1
45 S VAINDT=SRDATE
46 D INP^VADPT
47 I VAIN(1) S SRINOUT="I"
48 I 'VAIN(1) S SRINOUT="O"
49 K VAINDT,VAIN
50 I '$$CLINIC^SROUTL(SRLOC,SRTN) S SRK=1 Q
51 S SRX=0,SRX=$O(^SRF(SRTN,"PADX",SRX)) I SRX="" S SRK=1 Q
52 S SRX=0 F S SRX=$O(^SRF(SRTN,13,SRX)) Q:'SRX I $D(^SRF(SRTN,13,SRX)),'$D(^SRF(SRTN,13,SRX,"OADX")) S SRK=1 Q:SRK
53 S SRX=0 F S SRX=$O(^SRF(SRTN,15,SRX)) Q:'SRX I '$P($G(^SRF(SRTN,15,SRX,0)),"^",3) S SRK=1 Q:SRK
54 S SRRPROV="" I $D(^SRF(SRTN,18)) S SRX=0,SRX=$O(^SRF(SRTN,18,SRX)) I SRX S SRRPROV=$P($G(^SRF(SRTN,18,SRX,0)),"^",7)
55 S (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV)=0,SRSC=$P(SR(0),"^",16),SRAO=$P(SR(0),"^",17),SRIR=$P(SR(0),"^",18),SREC=$P(SR(0),"^",19),SRMST=$P(SR(0),"^",22),SRHNC=$P(SR(0),"^",23),SRCV=$P(SR(0),"^",24)
56 Q
57PCE ; set up call to PCE
58 N SRI,SRJ,SRCODE,SROTH D TMP
59D2PCE S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) I SRVSIT K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR,^SRF("APCE",SRTN)
60 K ^TMP("SRPXAPI",$J),SRVSIT
61 Q
62TMP ; set up ^TMP global array
63ENC S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=SRDATE
64 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
65 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=SRLOC
66 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
67 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
68 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
69 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"APPT")=9
70 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SC")=SRSC
71 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"AO")=SRAO
72 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"IR")=SRIR
73 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"EC")=SREC
74 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"MST")=SRMST
75 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HNC")=SRHNC
76 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CV")=SRCV
77PROC S SRI=1,SRCODE=SRCPT,SRNAR=$P(^SRF(SRTN,"OP"),"^") D PMOD,CPT
78 S SROTH=0 F S SROTH=$O(^SRF(SRTN,13,SROTH)) Q:'SROTH I $P(^SRF(SRTN,13,SROTH,0),"^",3)'="N" S SRCODE=$P($G(^SRF(SRTN,13,SROTH,2)),"^") I SRCODE S SRNAR=$P(^SRF(SRTN,13,SROTH,0),"^"),SRI=SRI+1 D OMOD,CPT
79PROV S ^TMP("SRPXAPI",$J,"PROVIDER",1,"NAME")=SRPROV
80 S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
81 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",1,"COMMENT")="Surgeon"
82 I SRPROV=SRATT!'SRATT S ^TMP("SRPXAPI",$J,"PROVIDER",1,"ATTENDING")=1 G DIAG
83 I 'SRATT G DIAG
84 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"NAME")=SRATT
85 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"ATTENDING")=1
86 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"PRIMARY")=0
87 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
88DIAG S SRI=1,SRDX=SRDIAG,SRDXN=$S(SRNON:$P($G(^SRF(SRTN,33)),"^",2),1:$P($G(^SRF(SRTN,34)),"^")) D DX
89 S SRD=0 F S SRD=$O(^SRF(SRTN,15,SRD)) Q:'SRD S SRDX=$P(^SRF(SRTN,15,SRD,0),"^",3) I SRDX S SRDXN=$P(^SRF(SRTN,15,SRD,0),"^") D DX
90 I 'SRDXF,SRODIAG D
91 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRODIAG
92 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="O"
93 .S SRDXN=$P($G(^SRF(SRTN,33)),"^")
94 .I SRDXN'="" S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"NARRATIVE")=SRDXN
95 Q
96DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
97 I SRI=1 D
98 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
99 .I SRDXF S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="OR"
100 .I 'SRDXF S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="R"
101 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SC")=SRSC
102 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL AO")=SRAO
103 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL IR")=SRIR
104 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL EC")=SREC
105 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL MST")=SRMST
106 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL HNC")=SRHNC
107 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CV")=SRCV
108 I SRI'=1 D
109 .S SR(15)=$G(^SRF(SRTN,15,SRD,2))
110 .S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV)=0,SRPLSC=$P(SR(15),"^",1),SRPLAO=$P(SR(15),"^",2),SRPLIR=$P(SR(15),"^",3),SRPLMST=$P(SR(15),"^",4),SRPLHNC=$P(SR(15),"^",5),SRPLEC=$P(SR(15),"^",6),SRPLCV=$P(SR(15),"^",7)
111 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="R"
112 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SC")=SRPLSC
113 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL AO")=SRPLAO
114 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL IR")=SRPLIR
115 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL EC")=SRPLEC
116 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL MST")=SRPLMST
117 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL HNC")=SRPLHNC
118 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CV")=SRPLCV
119 I SRDXN'="" S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"NARRATIVE")=SRDXN
120 S SRI=SRI+1
121 Q
122CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=SRPROV
123 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
124 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
125 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
126 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"NARRATIVE")=SRNAR
127 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"QTY")=1
128 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
129 I SRI=1 D
130 .S SRCNT=1,SRX=0 F S SRX=$O(^SRF(SRTN,"PADX",SRX)) Q:'SRX D
131 ..S SRADX1=$P(^SRF(SRTN,"PADX",SRX,0),"^",1)
132 ..I SRADX1=0 S SRADX=SRDIAG ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
133 ..I SRADX1'=0 S SRADX=$P(^SRF(SRTN,15,SRADX1,0),"^",3)
134 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS")=SRADX
135 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
136 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
137 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
138 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
139 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
140 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
141 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
142 ..S SRCNT=SRCNT+1
143 I SRI'=1 D
144 .S SRCNT=1,SRX=0 F S SRX=$O(^SRF(SRTN,13,SROTH,"OADX",SRX)) Q:'SRX D
145 ..S SRADX1=$P(^SRF(SRTN,13,SROTH,"OADX",SRX,0),"^",1)
146 ..I SRADX1=0 S SRADX=SRDIAG ; 0 IS A FLAG USED TO INDICATE DX IS PRIMARY DX AND NOT OTHER DX
147 ..I SRADX1'=0 S SRADX=$P(^SRF(SRTN,15,SRADX1,0),"^",3)
148 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
149 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
150 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
151 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
152 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
153 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
154 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
155 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
156 ..S SRCNT=SRCNT+1
157 Q
158PMOD ; get modifiers for principal CPT code
159 N SRM,SRMOD,X
160 S SRM=0 F S SRM=$O(^SRF(SRTN,"OPMOD",SRM)) Q:'SRM S X=$P(^SRF(SRTN,"OPMOD",SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
161 S SRMOD="" I $O(^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'="" S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS")=""
162 Q
163OMOD ; get modifiers for other CPT codes
164 N SRM,SRMOD,X
165 S SRM=0 F S SRM=$O(^SRF(SRTN,13,SROTH,"MOD",SRM)) Q:'SRM S X=$P(^SRF(SRTN,13,SROTH,"MOD",SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
166 S SRMOD="" I $O(^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD))'="" S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS")=""
167 Q
Note: See TracBrowser for help on using the repository browser.