116 lines
4.7 KiB
Mathematica
116 lines
4.7 KiB
Mathematica
|
SROCDX1 ;BIR/ADM,BAJ - ASSOCIATED DIAGNOSIS FOR CODER SCREENS ; 4/17/07 11:04am
|
||
|
|
;;3.0; Surgery ;**142,161**;24 Jun 93;Build 5
|
||
|
|
OTHADX ;Display ASDX for OTHER PROCS
|
||
|
|
N SRTMP,SRASSD,SROICD
|
||
|
|
S SRPADX=0,SROCNTR=1 F SRI=1:1 S SRPADX=$O(^SRO(136,SRTN,3,OTH,2,SRPADX)) Q:'SRPADX D
|
||
|
|
.S SRICD9=^SRO(136,SRTN,3,OTH,2,SRPADX,0)
|
||
|
|
.S:SRICD9 SROICD=$$ICDSTR
|
||
|
|
.S SRTMP(SRI)=SROICD,SROCNTR=SROCNTR+1
|
||
|
|
S SROCNTR=0
|
||
|
|
D ADXDISP I '$O(^SRO(136,SRTN,3,OTH,2,0)) W "NOT ENTERED",!
|
||
|
|
D PASSDIAG,ASSDIAG
|
||
|
|
Q
|
||
|
|
ASDX ;Display ASDX for PRIN Procs
|
||
|
|
N SRI,SRFIRST,SRICD9,SRPRIN,SRPADX,SRASSD K SRTMP
|
||
|
|
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)
|
||
|
|
S SRPADX=0,SROCNTR=2 F SRI=1:1 S SRPADX=$O(^SRO(136,SRTN,2,SRPADX)) Q:'SRPADX D
|
||
|
|
.S SRICD9=^SRO(136,SRTN,2,SRPADX,0)
|
||
|
|
.S:SRICD9 SROICD=$$ICDSTR
|
||
|
|
.S SRTMP(SRI)=SROICD,SROCNTR=SROCNTR+1
|
||
|
|
D ADXDISP I '$O(^SRO(136,SRTN,2,0)) W !,?5,SRMSG
|
||
|
|
D PASSDIAG,ASSDIAG
|
||
|
|
Q
|
||
|
|
AASDX S SROICD=""
|
||
|
|
S:SRASSD SRICD9=$P($G(^SRO(136,SRTN,4,SRASSD,0)),U)
|
||
|
|
S:'SRASSD SRICD9=$P($G(^SRO(136,SRTN,0)),U,3)
|
||
|
|
S:SRICD9 SROICD=$$ICDSTR
|
||
|
|
Q
|
||
|
|
PASSDIAG N ADCNT,SRICD9,SRFLG,SRCNTR,SRASSD ;List PRIN DX to assoc.
|
||
|
|
K SRADX,SRDIRX,SRADIAG S SRICD9=$P($G(^SRO(136,SRTN,0)),U,3)
|
||
|
|
I SRICD9'="" S SRDIRX(1)=$$ICDSTR,SRADX(1)=$P(^ICD9(SRICD9,0),U,1),SRADIAG(1)=$P($G(^SRO(136,SRTN,0)),U,3)
|
||
|
|
I SRICD9="" S SRDIRX(1)="",SRADIAG(1)=""
|
||
|
|
Q
|
||
|
|
ASSDIAG N SRDCNT,SRADCNT,SRQ ;DXs for assoc.
|
||
|
|
S (ADCNT,SRASSD)=0 S SRCNT=$S($G(SRDIRX(1))'="":1,1:0)
|
||
|
|
F S ADCNT=$O(^SRO(136,SRTN,4,ADCNT)) Q:ADCNT="" D
|
||
|
|
.S SRICD9=$P(^SRO(136,SRTN,4,ADCNT,0),U)
|
||
|
|
.S:SRICD9'="" SRCNT=SRCNT+1,SRDIRX(SRCNT)=$$ICDSTR,SRADX(SRCNT)=$P(^ICD9(SRICD9,0),U,1)
|
||
|
|
.S:SRICD9="" SRDIRX(SRCNT)=$P(^SRO(136,SRTN,4,ADCNT,0),U)
|
||
|
|
.S SRADIAG(SRCNT)=$P(^SRO(136,SRTN,4,ADCNT,0),U)
|
||
|
|
;modified to use 1 as lower limit, SRCNT as upper (SRO*3.0*161)
|
||
|
|
S:$D(SRDIRX) SRDX2="LO^1:"_SRCNT
|
||
|
|
Q
|
||
|
|
SRDIAGS() N SRDIAGS,SRDGCNT
|
||
|
|
S (SRDIAGS,SRDGCNT)=0 S:$D(^SRF(SRTN,34)) SRDIAGS=1
|
||
|
|
F I=1:1 S SRDGCNT=$O(^SRF(SRTN,15,SRDGCNT)) Q:SRDGCNT="" S SRDIAGS=SRDIAGS+1
|
||
|
|
Q SRDIAGS
|
||
|
|
ICDSTR() N SRICDSTR
|
||
|
|
S SRICDSTR=$P($$ICDDX^ICDCODE(SRICD9,SRSDATE),U,2)_"-"_$P($$ICDDX^ICDCODE(SRICD9,SRSDATE),U,4)
|
||
|
|
Q SRICDSTR
|
||
|
|
PASSDS() N SRDX,SRI,SRJ,SRPADX,SRASSDS,SRPX
|
||
|
|
S SRASSDS="",SRPADX=0 F S SRPADX=$O(^SRO(136,SRTN,2,SRPADX)) Q:'SRPADX D
|
||
|
|
.S SRDX=$P(^SRO(136,SRTN,2,SRPADX,0),"^")
|
||
|
|
.S SRJ=0 F S SRJ=$O(SRADIAG(SRJ)) Q:'SRJ I SRADIAG(SRJ)=SRDX S SRPX=SRJ Q
|
||
|
|
.S SRASSDS=$S($L(SRASSDS)<1:SRPX,1:SRASSDS_","_SRPX)
|
||
|
|
Q SRASSDS
|
||
|
|
OASSDS() N SRDX,SRI,SRJ,SRPADX,SRASSDS,SRPX
|
||
|
|
S SRASSDS="",SRPADX=0 F S SRPADX=$O(^SRO(136,SRTN,3,SRPOTH,2,SRPADX)) Q:'SRPADX D
|
||
|
|
.S SRDX=$P(^SRO(136,SRTN,3,SRPOTH,2,SRPADX,0),"^")
|
||
|
|
.S SRJ=0 F S SRJ=$O(SRADIAG(SRJ)) Q:'SRJ I SRADIAG(SRJ)=SRDX S SRPX=SRJ Q
|
||
|
|
.S SRASSDS=$S($L(SRASSDS)<1:SRPX,1:SRASSDS_","_SRPX)
|
||
|
|
Q SRASSDS
|
||
|
|
OTHADXD N SRCOMMA,SROADX,SRICD9,SROADX1,SROODX,SRASSD,SRSUB ;OTHER PROCS ADXs
|
||
|
|
I '$O(^SRO(136,SRTN,3,OTH,2,0)) W !,?5,SRMSG Q
|
||
|
|
S SRSUB=1 D OTHADX
|
||
|
|
Q
|
||
|
|
PADXD N SRCOMMA,SRPADX,SRICD9,SRPDX,SRPDX1,SROPRIN,SRSUB
|
||
|
|
S SRPADX=0,SROCNTR=2,SRSUB=1
|
||
|
|
I '$O(^SRO(136,SRTN,2,0)),$P(^SRO(136,SRTN,0),U,3) D
|
||
|
|
.S SRASSD=$P(^SRO(136,SRTN,0),U,3),SRFDA="136.02",SRIENU="+1"_","_SRTN_",",SRIENF=0_","_SRTN_"," D UPDATE,FILE
|
||
|
|
D ASDX
|
||
|
|
Q
|
||
|
|
ADXDISP N SROCNTR ;ADXS for PROC
|
||
|
|
W !,?5,"Assoc. DX: " N SRFIRST
|
||
|
|
S (SROCNTR,SRDXCNT)=0,SRFIRST=1
|
||
|
|
F I=1:1 S SROCNTR=$O(SRTMP(SROCNTR)) Q:'SROCNTR D
|
||
|
|
.I $D(SRSUB) D
|
||
|
|
..W:'(I#2) ?48 W:I#2 ?16 W $E(SRTMP(SROCNTR),1,28)
|
||
|
|
..I '(I#2),($O(SRTMP(SROCNTR))) W !
|
||
|
|
.I '$D(SRSUB) W:'SRFIRST ! W ?16,$E(SRTMP(SROCNTR),1,28) S SRFIRST=0
|
||
|
|
S SRDXCNT=I,SRDX1="LO^:"_SRDXCNT S:SRDXCNT>0 SRDX1="LO^:"_SRDXCNT
|
||
|
|
Q
|
||
|
|
PADD1 ;PRIN ADX
|
||
|
|
N SRY,SRY0,SRY1,SRY2,SRC,REC,DIE,DA,DR,SRASSD
|
||
|
|
S SRY(0)=Y(0)
|
||
|
|
D KPADX^SROCDX2(SRTN)
|
||
|
|
S SRCNTR=0,SRASSD=SRADIAG($P(SRY(0),",",1)),SRFDA="136.02",SRIENU="+1"_","_SRTN_",",SRIENF=SRCNTR_","_SRTN_"," D UPDATE,FILE
|
||
|
|
S SRY(0)=$E(SRY(0),2,$L(SRY(0)))
|
||
|
|
F SRY2=1:1:$P(SRDX2,":",2) D
|
||
|
|
.S SRY0=$P(SRY(0),",",SRY2)
|
||
|
|
.Q:SRY0<1
|
||
|
|
.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
|
||
|
|
S Y(0)=SRY(0)
|
||
|
|
Q
|
||
|
|
OADD1 N SRY,SRY0,SRY1,SRY2,SRCNTR,SRASSD ;Associate 1 Diagnosis to OTHER Procedure
|
||
|
|
S SRY(0)=Y(0),SRCNTR=0
|
||
|
|
S:$D(^SRO(136,SRTN,3,OTH,2)) SRCNTR=$P(^SRO(136,SRTN,3,OTH,2,0),U,3)+1
|
||
|
|
D KOADX^SROCDX2(SRTN,OTH)
|
||
|
|
S:'$D(^SRO(136,SRTN,3,OTH,2)) SRCNTR=1
|
||
|
|
S SRFDA="136.32",SRIENU="+1"_","_OTH_","_SRTN_","
|
||
|
|
F SRY2=1:1:$P(SRDX2,":",2) D
|
||
|
|
.S SRY0=$P(SRY(0),",",SRY2)
|
||
|
|
.Q:'SRY0
|
||
|
|
.S SRASSD=SRADIAG(SRY0),SRIENF=SRCNTR_","_OTH_","_SRTN_"," K SRY1 D UPDATE,FILE
|
||
|
|
.S SRCNTR=SRCNTR+1
|
||
|
|
S Y(0)=SRY(0)
|
||
|
|
Q
|
||
|
|
UPDATE ;
|
||
|
|
S SRY1(SRFDA,SRIENU,".01")=SRASSD
|
||
|
|
D UPDATE^DIE("","SRY1")
|
||
|
|
Q
|
||
|
|
FILE ;
|
||
|
|
S SRY1(SRFDA,SRIENF,".01")=SRASSD D FILE^DIE("","SRY1") K SRY1
|
||
|
|
Q
|
||
|
|
CONT N DIR S DIR(0)="FO^",DIR("A")="Press RETURN to continue " D ^DIR
|
||
|
|
Q
|