source: FOIAVistA/tag/r/SURGERY-SR/SROPCEP.m@ 1550

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1SROPCEP ;BIR/TJH - PCE UPDATES ;04/26/05 9:28 AM
2 ;;3.0; Surgery ;**142,152,144,161**;24 Jun 93;Build 5
3 ;
4 ; Reference to $$DATA2PCE^PXAPI supported by DBIA #1889
5 ; Reference to $$DELVFILE^PXAPI supported by DBIA #1890
6 ; Reference to ^DIC(45.3 is supported by DBIA #218
7 ;
8 Q
9START ; entry for update to PCE with surgery & non-OR procedure data
10 I '$D(SRTN) S SRTN=$G(DA)
11 I SRTN="" Q
12 N DFN,SR,SRAO,SRATT,SRCHK,SRCPT,SRDATE,SRDIAG,SREC,SRHNC,SRIR,SRCV,SRPRJ,SRK,SRLOC,SRMST,SRNON,SROTH,SRPKG,SRPROV,SRS,SRSC,SRV,SRVSIT,SRX,SRX2
13 N SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ,SRADX,SRCNT,SRD,SRDX,SRRPROV,SRUP,SRINOUT,SRO,SRDEPC,SRPFSSAR
14 N SRDP,SRDC,SRDI,SRDL,SRDIE,SRDG,SRDM,SRDR,SRDH,SRDK,SRDA,SRD0,SRDDER,SRDG,SRDIC,SRDIC1,SRDICRRE,SRDIEDA,SRDIG,SRDIH,SRDIIENS,SRDISL,SRDISYS,SRDIU,SRDIV,SRDIWT,SRDN,SRDQ,SRDX,SRDY
15 D FM1 K DIC S DIC=9.4,DIC(0)="XM",X="SURGERY" D ^DIC K DIC D FM2 Q:Y=-1 S SRPKG=+Y
16 S SRS="SURGERY DATA" K ^TMP("SRPXAPI",$J)
17 D UTIL I 'SRK D PCE
18 Q
19DEL ; delete data from the Visit file and V files
20 D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015///@" D ^DIE K DA,DIE,DR D FM2
21 D FM1 S SRV=$$DELVFILE^PXAPI("ALL",SRVSIT) K SRVSIT D FM2
22 Q
23UTIL ; set procedure variables
24 N SRDIV,SRSITE,SRSR
25 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
26 S SRX=$P($G(^SRF(SRTN,0)),"^",15) I SRX S SRVSIT=SRX D DEL I '$D(^SRF(SRTN,0)) S SRK=1 Q
27 S SR(0)=$G(^SRF(SRTN,0)) I SR(0)=""!$P($G(^SRF(SRTN,30)),"^") S SRK=1 Q
28 S DFN=$P(SR(0),"^")
29 S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0),SRCPT=$P($G(^SRO(136,SRTN,0)),"^",2) I 'SRCPT S SRK=1 Q
30 Q:SRK S SRDIAG=$P($G(^SRO(136,SRTN,0)),"^",3) I 'SRDIAG S SRK=1 Q
31 I 'SRNON D I SRK Q
32 .S SRX=$P(SR(0),"^",21) I SRX S SRLOC=SRX
33 .I 'SRX S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",5) I SRX S SRLOC=SRX
34 .I 'SRX S SRX=$P(SR(0),"^",2) S:SRX SRLOC=$P(^SRS(SRX,0),"^") I 'SRX S SRK=1 Q
35 .S SRX=$G(^SRF(SRTN,.2)),SRCHK=$P(SRX,"^",12) I 'SRCHK S SRK=1 Q
36 .S SRDATE=$P(SRX,"^",10) I 'SRDATE S SRK=1 Q
37 .S SRX=$G(^SRF(SRTN,.1)),SRPROV=$P(SRX,"^",4),SRATT=$P(SRX,"^",13) I 'SRPROV S SRK=1 Q
38 .I SRSR'=0,'SRATT S SRK=1 Q
39 I SRNON D I SRK Q
40 .S SRLOC=$P(SR(0),"^",21)
41 .S SRX=^SRF(SRTN,"NON"),SRCHK=$P(SRX,"^",5) I 'SRCHK S SRK=1 Q
42 .S SRDATE=$P(SRX,"^",4) I 'SRDATE S SRK=1 Q
43 .I 'SRLOC S SRLOC=$P(SRX,"^",2) I 'SRLOC S SRK=1 Q
44 .S SRPROV=$P(SRX,"^",6),SRATT=$P(SRX,"^",7) I 'SRPROV S SRK=1
45 .I SRSR'=0,'SRATT S SRK=1
46 S VAINDT=SRDATE
47 D INP^VADPT
48 I VAIN(1) S SRINOUT="I"
49 I 'VAIN(1) S SRINOUT="O"
50 K VAINDT,VAIN
51 I '$$CLINIC^SROUTL(SRLOC,SRTN) S SRK=1 Q
52 S SRX=0,SRX=$O(^SRO(136,SRTN,2,SRX)) I SRX="" S SRK=1 Q
53 S SRX=0 F S SRX=$O(^SRO(136,SRTN,3,SRX)) Q:'SRX S SRX2=0,SRX2=$O(^SRO(136,SRTN,3,SRX,2,SRX2)) I $D(^SRO(136,SRTN,3,SRX,0)),(SRX2="") 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 SRO(0)=$G(^SRO(136,SRTN,0))
56 S (SRSC,SRAO,SREC,SRHNC,SRIR,SRMST,SRCV,SRPRJ)=0,SRSC=$P(SRO(0),"^",4),SRAO=$P(SRO(0),"^",5),SRIR=$P(SRO(0),"^",6),SREC=$P(SRO(0),"^",7),SRMST=$P(SRO(0),"^",8),SRHNC=$P(SRO(0),"^",9),SRCV=$P(SRO(0),"^",10),SRPRJ=$P(SRO(0),"^",11)
57 I $$SWSTAT^IBBAPI(),'SRNON D
58 .S SRX=$P(^SRO(137.45,$P(SR(0),"^",4),0),"^",2)
59 .I SRX S SRDEPC=$$GET1^DIQ(45.3,SRX,2)
60 Q
61PCE ;
62 N SRI,SRJ,SRCODE,SROTH D TMP
63D2PCE ;
64 S SRPFSSAR=$P($G(^SRF(SRTN,"PFSS")),"^")
65 I $$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT,,,,,,.SRPFSSAR) D FM2
66 I '$$SWSTAT^IBBAPI() D FM1 S SRV=$$DATA2PCE^PXAPI("^TMP(""SRPXAPI"",$J)",SRPKG,SRS,.SRVSIT) D FM2
67 I SRVSIT D FM1 K DA,DIE,DR S DA=SRTN,DIE=130,DR=".015////"_SRVSIT D ^DIE K DA,DIE,DR D FM2
68 K ^TMP("SRPXAPI",$J),SRVSIT
69 Q
70TMP ;
71ENC S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=SRDATE
72 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
73 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=SRLOC
74 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CHECKOUT D/T")=SRCHK
75 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="S"
76 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="P"
77 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"APPT")=9
78 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SC")=SRSC
79 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"AO")=SRAO
80 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"IR")=SRIR
81 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"EC")=SREC
82 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"MST")=SRMST
83 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"HNC")=SRHNC
84 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"CV")=SRCV
85 S ^TMP("SRPXAPI",$J,"ENCOUNTER",1,"SHAD")=SRPRJ
86PROC S SRI=1,SRCODE=SRCPT D PMOD,CPT
87 S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH S SRCODE=$P($G(^SRO(136,SRTN,3,SROTH,0)),"^") I SRCODE S SRI=SRI+1 D OMOD,CPT
88PROV S ^TMP("SRPXAPI",$J,"PROVIDER",1,"NAME")=SRPROV
89 S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=1
90 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",1,"COMMENT")="Surgeon"
91 I SRPROV=SRATT!'SRATT S ^TMP("SRPXAPI",$J,"PROVIDER",1,"ATTENDING")=1 G DIAG
92 I 'SRATT G DIAG
93 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"NAME")=SRATT
94 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"ATTENDING")=1
95 S ^TMP("SRPXAPI",$J,"PROVIDER",2,"PRIMARY")=1
96 S ^TMP("SRPXAPI",$J,"PROVIDER",1,"PRIMARY")=0
97 I 'SRNON S ^TMP("SRPXAPI",$J,"PROVIDER",2,"COMMENT")="Attending Surgeon"
98DIAG S SRI=1,SRDX=SRDIAG D DX
99 S SRD=0 F S SRD=$O(^SRO(136,SRTN,4,SRD)) Q:'SRD S SRDX=$P(^SRO(136,SRTN,4,SRD,0),"^") I SRDX D DX
100 Q
101DX S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"DIAGNOSIS")=SRDX
102 I SRI=1 D
103 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PRIMARY")=1
104 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"ORD/RES")="R"
105 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SC")=SRSC
106 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL AO")=SRAO
107 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL IR")=SRIR
108 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL EC")=SREC
109 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL MST")=SRMST
110 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL HNC")=SRHNC
111 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL CV")=SRCV
112 .S ^TMP("SRPXAPI",$J,"DX/PL",1,"PL SHAD")=SRPRJ
113 I SRI'=1 D
114 .S SR(4)=$G(^SRO(136,SRTN,4,SRD,0))
115 .S (SRPLSC,SRPLAO,SRPLIR,SRPLEC,SRPLMST,SRPLHNC,SRPLCV,SRPLPRJ)=0,SRPLSC=$P(SR(4),"^",2),SRPLAO=$P(SR(4),"^",3)
116 .S SRPLIR=$P(SR(4),"^",4),SRPLMST=$P(SR(4),"^",5),SRPLHNC=$P(SR(4),"^",6),SRPLEC=$P(SR(4),"^",7),SRPLCV=$P(SR(4),"^",8),SRPLPRJ=$P(SR(4),"^",9)
117 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"ORD/RES")="R"
118 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SC")=SRPLSC
119 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL AO")=SRPLAO
120 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL IR")=SRPLIR
121 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL EC")=SRPLEC
122 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL MST")=SRPLMST
123 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL HNC")=SRPLHNC
124 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL CV")=SRPLCV
125 .S ^TMP("SRPXAPI",$J,"DX/PL",SRI,"PL SHAD")=SRPLPRJ
126 S SRI=SRI+1
127 Q
128CPT S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ENC PROVIDER")=$S($P($G(^SRF(SRTN,.1)),"^",3)="R":SRATT,1:SRPROV) ;; << *161 RJS
129 S:SRRPROV'="" ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"ORD PROVIDER")=SRRPROV
130 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"EVENT D/T")=SRDATE
131 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"PROCEDURE")=SRCODE
132 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"QTY")=1
133 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"COMMENT")=$S(SRI=1:"Principal Procedure",1:"Other Procedure")
134 I $G(SRDEPC) S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DEPARTMENT")=SRDEPC
135 I SRI=1 D
136 .S SRCNT=1,SRX=0 F S SRX=$O(^SRO(136,SRTN,2,SRX)) Q:'SRX D
137 ..S SRADX=$P(^SRO(136,SRTN,2,SRX,0),"^")
138 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS")=SRADX
139 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 2")=SRADX
140 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 3")=SRADX
141 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 4")=SRADX
142 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 5")=SRADX
143 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 6")=SRADX
144 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 7")=SRADX
145 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",1,"DIAGNOSIS 8")=SRADX
146 ..S SRCNT=SRCNT+1
147 I SRI'=1 D
148 .S SRCNT=1,SRX=0 F S SRX=$O(^SRO(136,SRTN,3,SROTH,2,SRX)) Q:'SRX D
149 ..S SRADX=$P(^SRO(136,SRTN,3,SROTH,2,SRX,0),"^")
150 ..I SRCNT=1 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS")=SRADX
151 ..I SRCNT=2 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 2")=SRADX
152 ..I SRCNT=3 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 3")=SRADX
153 ..I SRCNT=4 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 4")=SRADX
154 ..I SRCNT=5 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 5")=SRADX
155 ..I SRCNT=6 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 6")=SRADX
156 ..I SRCNT=7 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 7")=SRADX
157 ..I SRCNT=8 S ^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"DIAGNOSIS 8")=SRADX
158 ..S SRCNT=SRCNT+1
159 Q
160PMOD ;
161 N SRM,SRMOD,X
162 S SRM=0 F S SRM=$O(^SRO(136,SRTN,1,SRM)) Q:'SRM S X=$P(^SRO(136,SRTN,1,SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
163 Q
164OMOD ;
165 N SRM,SRMOD,X
166 S SRM=0 F S SRM=$O(^SRO(136,SRTN,3,SROTH,1,SRM)) Q:'SRM S X=$P(^SRO(136,SRTN,3,SROTH,1,SRM,0),"^"),SRMOD=$P($$MOD^ICPTMOD(X,"I"),"^",2),^TMP("SRPXAPI",$J,"PROCEDURE",SRI,"MODIFIERS",SRMOD)=""
167 Q
168FM1 M SRDA=DA,SRDP=DP,SRDC=DC,SRDI=DI,SRDL=DL,SRDIE=DIE,SRDG=DG,SRDM=DM,SRDR=DR,SRDH=DH,SRDK=DK,SRD0=D0,SRDDER=DDER,SRDG=DG,SRDIC=DIC,SRDIC1=DIC1,SRDICRRE=DICRREC
169 M SRDIEDA=DIEDA,SRDIG=DIG,SRDIH=DIH,SRDIIENS=DIIENS,SRDISL=DISL,SRDISYS=DISYS,SRDIU=DIU,SRDIV=DIV,SRDIWT=DIWT,SRDN=DN,SRDQ=DQ,SRDX=DX,SRDY=DY
170FM2 M DA=SRDA,DP=SRDP,DC=SRDC,DI=SRDI,DL=SRDL,DIE=SRDIE,DG=SRDG,DM=SRDM,DR=SRDR,DH=SRDH,DK=SRDK,D0=SRD0,DDER=SRDDER,DG=SRDG,DIC=SRDIC,DIC1=SRDIC1,DICRREC=SRDICRRE
171 M DIEDA=SRDIEDA,DIG=SRDIG,DIH=SRDIH,DIIENS=SRDIIENS,DISL=SRDISL,DISYS=SRDISYS,DIU=SRDIU,DIV=SRDIV,DIWT=SRDIWT,DN=SRDN,DQ=SRDQ,DX=SRDX,DY=SRDY
Note: See TracBrowser for help on using the repository browser.