source: FOIAVistA/trunk/r/SURGERY-SR/SROCDX1.m

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