close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/SURGERY-SR/SROCDX1.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/SURGERY-SR/SROCDX1.m@ 846

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
1SROCDX1 ;BIR/ADM,BAJ - ASSOCIATED DIAGNOSIS FOR CODER SCREENS ; 4/17/07 11:04am
2 ;;3.0; Surgery ;**142,161**;24 Jun 93;Build 5
3OTHADX ;Display ASDX for OTHER PROCS
4 N SRTMP,SRASSD,SROICD
5 S SRPADX=0,SROCNTR=1 F SRI=1:1 S SRPADX=$O(^SRO(136,SRTN,3,OTH,2,SRPADX)) Q:'SRPADX D
6 .S SRICD9=^SRO(136,SRTN,3,OTH,2,SRPADX,0)
7 .S:SRICD9 SROICD=$$ICDSTR
8 .S SRTMP(SRI)=SROICD,SROCNTR=SROCNTR+1
9 S SROCNTR=0
10 D ADXDISP I '$O(^SRO(136,SRTN,3,OTH,2,0)) W "NOT ENTERED",!
11 D PASSDIAG,ASSDIAG
12 Q
13ASDX ;Display ASDX for PRIN Procs
14 N SRI,SRFIRST,SRICD9,SRPRIN,SRPADX,SRASSD K SRTMP
15 S SRI=0,SRFIRST=1 F S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI S SRM=$P(^SRO(136,SRTN,1,SRI,0),U)
16 S SRPADX=0,SROCNTR=2 F SRI=1:1 S SRPADX=$O(^SRO(136,SRTN,2,SRPADX)) Q:'SRPADX D
17 .S SRICD9=^SRO(136,SRTN,2,SRPADX,0)
18 .S:SRICD9 SROICD=$$ICDSTR
19 .S SRTMP(SRI)=SROICD,SROCNTR=SROCNTR+1
20 D ADXDISP I '$O(^SRO(136,SRTN,2,0)) W !,?5,SRMSG
21 D PASSDIAG,ASSDIAG
22 Q
23AASDX S SROICD=""
24 S:SRASSD SRICD9=$P($G(^SRO(136,SRTN,4,SRASSD,0)),U)
25 S:'SRASSD SRICD9=$P($G(^SRO(136,SRTN,0)),U,3)
26 S:SRICD9 SROICD=$$ICDSTR
27 Q
28PASSDIAG N ADCNT,SRICD9,SRFLG,SRCNTR,SRASSD ;List PRIN DX to assoc.
29 K SRADX,SRDIRX,SRADIAG S SRICD9=$P($G(^SRO(136,SRTN,0)),U,3)
30 I SRICD9'="" S SRDIRX(1)=$$ICDSTR,SRADX(1)=$P(^ICD9(SRICD9,0),U,1),SRADIAG(1)=$P($G(^SRO(136,SRTN,0)),U,3)
31 I SRICD9="" S SRDIRX(1)="",SRADIAG(1)=""
32 Q
33ASSDIAG N SRDCNT,SRADCNT,SRQ ;DXs for assoc.
34 S (ADCNT,SRASSD)=0 S SRCNT=$S($G(SRDIRX(1))'="":1,1:0)
35 F S ADCNT=$O(^SRO(136,SRTN,4,ADCNT)) Q:ADCNT="" D
36 .S SRICD9=$P(^SRO(136,SRTN,4,ADCNT,0),U)
37 .S:SRICD9'="" SRCNT=SRCNT+1,SRDIRX(SRCNT)=$$ICDSTR,SRADX(SRCNT)=$P(^ICD9(SRICD9,0),U,1)
38 .S:SRICD9="" SRDIRX(SRCNT)=$P(^SRO(136,SRTN,4,ADCNT,0),U)
39 .S SRADIAG(SRCNT)=$P(^SRO(136,SRTN,4,ADCNT,0),U)
40 ;modified to use 1 as lower limit, SRCNT as upper (SRO*3.0*161)
41 S:$D(SRDIRX) SRDX2="LO^1:"_SRCNT
42 Q
43SRDIAGS() N SRDIAGS,SRDGCNT
44 S (SRDIAGS,SRDGCNT)=0 S:$D(^SRF(SRTN,34)) SRDIAGS=1
45 F I=1:1 S SRDGCNT=$O(^SRF(SRTN,15,SRDGCNT)) Q:SRDGCNT="" S SRDIAGS=SRDIAGS+1
46 Q SRDIAGS
47ICDSTR() N SRICDSTR
48 S SRICDSTR=$P($$ICDDX^ICDCODE(SRICD9,SRSDATE),U,2)_"-"_$P($$ICDDX^ICDCODE(SRICD9,SRSDATE),U,4)
49 Q SRICDSTR
50PASSDS() N SRDX,SRI,SRJ,SRPADX,SRASSDS,SRPX
51 S SRASSDS="",SRPADX=0 F S SRPADX=$O(^SRO(136,SRTN,2,SRPADX)) Q:'SRPADX D
52 .S SRDX=$P(^SRO(136,SRTN,2,SRPADX,0),"^")
53 .S SRJ=0 F S SRJ=$O(SRADIAG(SRJ)) Q:'SRJ I SRADIAG(SRJ)=SRDX S SRPX=SRJ Q
54 .S SRASSDS=$S($L(SRASSDS)<1:SRPX,1:SRASSDS_","_SRPX)
55 Q SRASSDS
56OASSDS() N SRDX,SRI,SRJ,SRPADX,SRASSDS,SRPX
57 S SRASSDS="",SRPADX=0 F S SRPADX=$O(^SRO(136,SRTN,3,SRPOTH,2,SRPADX)) Q:'SRPADX D
58 .S SRDX=$P(^SRO(136,SRTN,3,SRPOTH,2,SRPADX,0),"^")
59 .S SRJ=0 F S SRJ=$O(SRADIAG(SRJ)) Q:'SRJ I SRADIAG(SRJ)=SRDX S SRPX=SRJ Q
60 .S SRASSDS=$S($L(SRASSDS)<1:SRPX,1:SRASSDS_","_SRPX)
61 Q SRASSDS
62OTHADXD N SRCOMMA,SROADX,SRICD9,SROADX1,SROODX,SRASSD,SRSUB ;OTHER PROCS ADXs
63 I '$O(^SRO(136,SRTN,3,OTH,2,0)) W !,?5,SRMSG Q
64 S SRSUB=1 D OTHADX
65 Q
66PADXD N SRCOMMA,SRPADX,SRICD9,SRPDX,SRPDX1,SROPRIN,SRSUB
67 S SRPADX=0,SROCNTR=2,SRSUB=1
68 I '$O(^SRO(136,SRTN,2,0)),$P(^SRO(136,SRTN,0),U,3) D
69 .S SRASSD=$P(^SRO(136,SRTN,0),U,3),SRFDA="136.02",SRIENU="+1"_","_SRTN_",",SRIENF=0_","_SRTN_"," D UPDATE,FILE
70 D ASDX
71 Q
72ADXDISP N SROCNTR ;ADXS for PROC
73 W !,?5,"Assoc. DX: " N SRFIRST
74 S (SROCNTR,SRDXCNT)=0,SRFIRST=1
75 F I=1:1 S SROCNTR=$O(SRTMP(SROCNTR)) Q:'SROCNTR D
76 .I $D(SRSUB) D
77 ..W:'(I#2) ?48 W:I#2 ?16 W $E(SRTMP(SROCNTR),1,28)
78 ..I '(I#2),($O(SRTMP(SROCNTR))) W !
79 .I '$D(SRSUB) W:'SRFIRST ! W ?16,$E(SRTMP(SROCNTR),1,28) S SRFIRST=0
80 S SRDXCNT=I,SRDX1="LO^:"_SRDXCNT S:SRDXCNT>0 SRDX1="LO^:"_SRDXCNT
81 Q
82PADD1 ;PRIN ADX
83 N SRY,SRY0,SRY1,SRY2,SRC,REC,DIE,DA,DR,SRASSD
84 S SRY(0)=Y(0)
85 D KPADX^SROCDX2(SRTN)
86 S SRCNTR=0,SRASSD=SRADIAG($P(SRY(0),",",1)),SRFDA="136.02",SRIENU="+1"_","_SRTN_",",SRIENF=SRCNTR_","_SRTN_"," D UPDATE,FILE
87 S SRY(0)=$E(SRY(0),2,$L(SRY(0)))
88 F SRY2=1:1:$P(SRDX2,":",2) D
89 .S SRY0=$P(SRY(0),",",SRY2)
90 .Q:SRY0<1
91 .S SRCNTR=$P(^SRO(136,SRTN,2,0),U,3)+1,SRASSD=SRADIAG(SRY0),SRFDA="136.02",SRIENU="+1"_","_SRTN_",",SRIENF=SRCNTR_","_SRTN_"," D UPDATE,FILE
92 S Y(0)=SRY(0)
93 Q
94OADD1 N SRY,SRY0,SRY1,SRY2,SRCNTR,SRASSD ;Associate 1 Diagnosis to OTHER Procedure
95 S SRY(0)=Y(0),SRCNTR=0
96 S:$D(^SRO(136,SRTN,3,OTH,2)) SRCNTR=$P(^SRO(136,SRTN,3,OTH,2,0),U,3)+1
97 D KOADX^SROCDX2(SRTN,OTH)
98 S:'$D(^SRO(136,SRTN,3,OTH,2)) SRCNTR=1
99 S SRFDA="136.32",SRIENU="+1"_","_OTH_","_SRTN_","
100 F SRY2=1:1:$P(SRDX2,":",2) D
101 .S SRY0=$P(SRY(0),",",SRY2)
102 .Q:'SRY0
103 .S SRASSD=SRADIAG(SRY0),SRIENF=SRCNTR_","_OTH_","_SRTN_"," K SRY1 D UPDATE,FILE
104 .S SRCNTR=SRCNTR+1
105 S Y(0)=SRY(0)
106 Q
107UPDATE ;
108 S SRY1(SRFDA,SRIENU,".01")=SRASSD
109 D UPDATE^DIE("","SRY1")
110 Q
111FILE ;
112 S SRY1(SRFDA,SRIENF,".01")=SRASSD D FILE^DIE("","SRY1") K SRY1
113 Q
114CONT N DIR S DIR(0)="FO^",DIR("A")="Press RETURN to continue " D ^DIR
115 Q
Note: See TracBrowser for help on using the repository browser.