Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROADX1

SROADX1.m

Go to the documentation of this file.
  1. SROADX1 ;BIR/RJS - CONTINUED FROM SROADX ASSOCIATED DIAGNOSIS FOR CODER AND VERIFY SCREENS ;09/12/05 12:01pm
  1. ;;3.0;Surgery;**119,150,177**;24 Jun 93;Build 89
  1. OTHADX ;Display ASDX for OTHER PROCS
  1. K SRTMP,SRASSD,SROICD
  1. S SRPADX=0,SROCNTR=1
  1. F SRI=1:1 S SRPADX=$O(^SRF(SRTN,13,OTH,"OADX",SRPADX)) Q:'SRPADX D
  1. .S SRASSD=^SRF(SRTN,13,OTH,"OADX",SRPADX,0)
  1. .D AASDX
  1. .S SRTMP(SRI)=SROICD,SROCNTR=SROCNTR+1
  1. S SROCNTR=0
  1. D ADXDISP
  1. I '$O(^SRF(SRTN,13,OTH,"OADX",0)) W !,?5,SRMSG,!
  1. D PASSDIAG
  1. D ASSDIAG
  1. Q
  1. ASDX N SRI,SRFIRST,SRICD9,SRPRIN,SRPADX,SRASSD ;Display ASDX for PRIN Procs
  1. K SRTMP
  1. S SRI=0,SRFIRST=1
  1. F S SRI=$O(^SRF(SRTN,"OPMOD",SRI)) Q:'SRI S SRM=$P(^SRF(SRTN,"OPMOD",SRI,0),U)
  1. S SRPADX=0,SROCNTR=2
  1. F SRI=1:1 S SRPADX=$O(^SRF(SRTN,"PADX",SRPADX)) Q:'SRPADX D
  1. .S SRASSD=^SRF(SRTN,"PADX",SRPADX,0)
  1. .D AASDX
  1. .S SRTMP(SRI)=SROICD,SROCNTR=SROCNTR+1
  1. D ADXDISP
  1. I '$O(^SRF(SRTN,"PADX",0)) W !,?5,SRMSG
  1. D PASSDIAG
  1. D ASSDIAG
  1. Q
  1. AASDX S SROICD=""
  1. S:SRASSD SRICD9=$P($G(^SRF(SRTN,15,SRASSD,0)),U,3)
  1. S:'SRASSD SRICD9=$P($G(^SRF(SRTN,34)),U,2)
  1. S:SRICD9 SROICD=$$ICDSTR
  1. I 'SRICD9 D
  1. .S:SRASSD SROICD=$P($G(^SRF(SRTN,15,SRASSD,0)),U)
  1. .S:'SRASSD SROICD=$P($G(^SRF(SRTN,34)),U,1)
  1. Q
  1. PASSDIAG N ADCNT,SRICD9,SRFLG,SRCNTR,SRASSD ;List PRIN DX to assoc.
  1. K SRADX,SRDIRX,SRADIAG
  1. S SRICD9=$P($G(^SRF(SRTN,34)),U,2)
  1. I SRICD9'="" S SRDIRX(1)=$$ICDSTR,SRADX(1)=$P(SRDIRX(1),U,2),SRADIAG(1)=0
  1. I SRICD9="" S SRDIRX(1)=$P($G(^SRF(SRTN,34)),U,1),SRADIAG(1)=0
  1. Q
  1. ASSDIAG N SRDCNT,SRADCNT,SRQ ;DXs for assoc.
  1. S (ADCNT,SRASSD)=0,SRCNT=2
  1. F S ADCNT=$O(^SRF(SRTN,15,ADCNT)) Q:ADCNT="" D
  1. .S SRICD9=$P(^SRF(SRTN,15,ADCNT,0),U,3)
  1. .S:SRICD9'="" SRDIRX(SRCNT)=$$ICDSTR,SRADX(SRCNT)=$P(SRDIRX(SRCNT),U,2)
  1. .S:SRICD9="" SRDIRX(SRCNT)=$P(^SRF(SRTN,15,ADCNT,0),U,1)
  1. .S SRADIAG(SRCNT)=ADCNT,SRCNT=SRCNT+1
  1. S SRDX2="LO^:0"
  1. I (ADCNT<$$SRDIAGS) D
  1. .S:(SRCNT>2) SRDIRX(SRCNT)="ALL"
  1. .S:$D(SRDIRX) SRDX2="LO^:"_SRCNT
  1. .S:$$SRDIAGS=1 SRDX2="LO^:"_(SRCNT-1)
  1. Q
  1. SRDIAGS() N SRDIAGS,SRDGCNT
  1. S (SRDIAGS,SRDGCNT)=0
  1. S:($P($G(^SRF(SRTN,34)),U)'="")!($P($G(^SRF(SRTN,34)),U,2)) SRDIAGS=1
  1. F I=1:1 S SRDGCNT=$O(^SRF(SRTN,15,SRDGCNT)) Q:SRDGCNT="" S SRDIAGS=SRDIAGS+1
  1. Q SRDIAGS
  1. ICDSTR() N SRICDSTR
  1. S SRICDSTR=$$ICD^SROICD(SRTN,SRICD9),SRICDSTR=$P(SRICDSTR,U,2)_"-"_$P(SRICDSTR,U,4)
  1. Q SRICDSTR
  1. PASSDS() N SRPADX,SRASSDS,SRPX
  1. S SRASSDS="",SRPADX=0
  1. F SRI=1:1 S SRPADX=$O(^SRF(SRTN,"PADX",SRPADX)) Q:'SRPADX D
  1. .S SRPX=^SRF(SRTN,"PADX",SRPADX,0)
  1. .S SRPX=SRPX+1
  1. .S SRASSDS=$S($L(SRASSDS)<1:SRPX,1:SRASSDS_","_SRPX)
  1. Q SRASSDS
  1. OASSDS() N SRPADX,SRASSDS,SRPX
  1. S SRASSDS="",SRPADX=0
  1. F SRI=1:1 S SRPADX=$O(^SRF(SRTN,13,D0,"OADX",SRPADX)) Q:'SRPADX D
  1. .S SRPX=^SRF(SRTN,13,D0,"OADX",SRPADX,0)
  1. .S SRPX=SRPX+1
  1. .S SRASSDS=$S($L(SRASSDS)<1:SRPX,1:SRASSDS_","_SRPX)
  1. Q SRASSDS
  1. SRODIR N SRFLG,SRCNT,SRCNTR
  1. S DIR("A",1)=""
  1. S (SRFLG,SRCNT)=1,SRCNTR=2,ADCNT=""
  1. F S ADCNT=$O(SRDIRX(ADCNT)) Q:'ADCNT D
  1. .S:'$D(DIR("A",SRCNTR)) DIR("A",SRCNTR)=""
  1. .S DIR("A",SRCNTR)=DIR("A",SRCNTR)_SRCNT_". "_SRDIRX(ADCNT),SRCNT=SRCNT+1,SRCNTR=SRCNTR+1,SRFLG=1
  1. S DIR("A",SRCNTR+2)=SRODIR("A",1),DIR("A")=SRODIR("A"),DIR("A",SRCNTR+1)=""
  1. Q
  1. COTHBLD N SRCNT,OTH,X,CPT,CPT1,SRDA K SRSEL
  1. S OTH=0,SRCNT=1
  1. F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH D
  1. .S OTHER=$P(^SRF(SRTN,13,OTH,0),U)
  1. .S X=$P($G(^SRF(SRTN,13,OTH,2)),U),CPT="NOT ENTERED",CPT1=""
  1. .I X S CPT1=X,Y=$$CPT^ICPTCOD(X),SRCPT=$P(Y,U,2),SRSHT=$P(Y,U,3),Y=SRCPT,SRDA=OTH D SSOTH^SROCPT S SRCPT=Y,CPT=SRCPT_" "_SRSHT
  1. .S SRSEL(SRCNT)=OTH_U_OTHER_"^CPT Code: "_CPT_U_CPT1
  1. .S SRCNT=SRCNT+1
  1. Q
  1. OTHADXD N SRCOMMA,SROADX,SRICD9,SROADX1,SROODX,SRASSD,SRSUB ;OTHER PROCS ADXs
  1. I '$O(^SRF(SRTN,13,OTH,"OADX",0)) W !,?5,SRMSG Q
  1. S SRSUB=1
  1. D OTHADX
  1. Q
  1. PADXD N SRCOMMA,SRPADX,SRICD9,SRPDX,SRPDX1,SROPRIN,SRSUB
  1. S SRPADX=0,SROCNTR=2,SRSUB=1
  1. D ADXCHK^SROADX2
  1. I '$O(^SRF(SRTN,"PADX",0)),(($P($G(^SRF(SRTN,34)),U)'="")!($P($G(^SRF(SRTN,34)),U,2))),(($P($G(^SRF(SRTN,"OP")),U)'="")!($P($G(^SRF(SRTN,"OP")),U,2))) D
  1. .S SRASSD=0,SRFDA="130.275",SRIENU="+1"_","_SRTN_",",SRIENF=0_","_SRTN_"," D UPDATE,FILE
  1. D ASDX
  1. Q
  1. ADXDISP N SROCNTR ;ADXS for PROC
  1. W !,?5,"Assoc. DX"_$$ICDSTR^SROICD(SRTN)_": "
  1. S (SROCNTR,SRDXCNT)=0
  1. F I=1:1 S SROCNTR=$O(SRTMP(SROCNTR)) Q:'SROCNTR D
  1. .I $D(SRSUB) D
  1. ..W:'(I#2) ?48
  1. ..W:I#2 ?16
  1. ..W I,". ",$E(SRTMP(SROCNTR),1,25)
  1. ..I '(I#2),($O(SRTMP(SROCNTR))) W !
  1. .W:'$D(SRSUB) !,?8,I,". ",SRTMP(SROCNTR)
  1. S SRDXCNT=I
  1. S SRDX1="LO^:"_SRDXCNT
  1. S:SRDXCNT>0 SRDX1="LO^:"_SRDXCNT
  1. Q
  1. OTHCPTD N SRM,SRI,SRFIRST ;PROCS/Codes/Mods.
  1. S SRFIRST=0
  1. W !,?3,"Other Procedures:",!!,OTHCNT,"."
  1. D COTHBLD
  1. W ?3,$P(SRSEL(SRDA),U,2),!,?2,"Other ",$P(SRSEL(SRDA),U,3)
  1. S OTH=$P(SRSEL(SRDA),U) K SRDES S CPT1=$P(SRSEL(SRDA),U,4),X=$$CPTD^ICPTCOD(CPT1,"SRDES") I $O(SRDES(0)) F I=1:1:X W !,?4,SRDES(I)
  1. W !,?3,"Modifiers: "
  1. S SRI=0
  1. F S SRI=$O(^SRF(SRTN,13,OTH,"MOD",SRI)) Q:'SRI D
  1. .S SRM=$P(^SRF(SRTN,13,OTH,"MOD",SRI,0),U)
  1. .W:SRFIRST !,?14
  1. .W $P($$MOD^ICPTMOD(SRM,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRM,"I"),"^",3)
  1. .S SRFIRST=1
  1. Q
  1. CPTDISP S X=$P(^SRF(SRTN,"OP"),U,2) I X D W !
  1. .S SRY=$$CPT^ICPTCOD(X),Y=$P(SRY,U,2),(SROCPT2,Z)=$P(SRY,U,3)
  1. S:'$D(Y) Y="NOT ENTERED",Z=""
  1. W " CPT Code: "_Y_" ",Z,!," Description:" D ^SROCPT W ! F I=1:1:80 W "-"
  1. W !,?3,"Principal CPT Code: "_Y_" ",!,?3,"Description:",Z,!,?3,"Modifiers: "
  1. S SRMOD=0
  1. F S SRMOD=$O(^SRF(SRTN,"OPMOD",SRMOD)) Q:'SRMOD D
  1. .S SRMO=$P(^SRF(SRTN,"OPMOD",SRMOD,0),U)
  1. .W:$G(SRFIRST) !,?14
  1. .W $P($$MOD^ICPTMOD(SRMO,"I"),"^",2),"-",$P($$MOD^ICPTMOD(SRMO,"I"),"^",3)
  1. .S SRFIRST=1
  1. Q
  1. PADDALL Q:$E($G(IOST))'="C"!($G(DIK)'="")
  1. D KPADX^SROADX2(DA)
  1. N DIE,DR,DA,PADX,SRY,SRY1,SRICD9,SRCNTRN,SRIENU,SRIENF,SRASSD
  1. S SRY(0)=Y(0),SRFDA="130.275",SRIENU="+1"_","_SRTN_","
  1. S SRICD9=$P($G(^SRF(SRTN,34)),U,2),SRCNTR=1,SRIENF=SRCNTR_","_SRTN_",",SRASSD=0
  1. K SRY1 D UPDATE,FILE
  1. S PADX=0
  1. F S PADX=$O(^SRF(SRTN,15,PADX)) Q:'PADX S SRASSD=PADX,SRICD9=$P(^SRF(SRTN,15,SRASSD,0),U,3),SRCNTR=SRCNTR+1,SRIENF=SRCNTR_","_SRTN_"," K SRY1 D UPDATE,FILE
  1. S Y(0)=SRY(0)
  1. Q
  1. PADD1 ;PRIN ADX
  1. N SRY,SRY0,SRY1,SRY2,SRC,REC,DIE,DA,DR,SRASSD
  1. S SRY(0)=Y(0)
  1. D KPADX^SROADX2(SRTN)
  1. S SRCNTR=0,SRASSD=SRADIAG($P(SRY(0),",",1)),SRFDA="130.275",SRIENU="+1"_","_SRTN_",",SRIENF=SRCNTR_","_SRTN_"," D UPDATE,FILE
  1. S SRY(0)=$E(SRY(0),2,$L(SRY(0)))
  1. F SRY2=1:1:$P(SRDX2,":",2) D
  1. .S SRY0=$P(SRY(0),",",SRY2)
  1. .Q:SRY0<1
  1. .S SRCNTR=$P(^SRF(SRTN,"PADX",0),U,3)+1,SRASSD=SRADIAG(SRY0),SRFDA="130.275",SRIENU="+1"_","_SRTN_",",SRIENF=SRCNTR_","_SRTN_"," D UPDATE,FILE
  1. S Y(0)=SRY(0)
  1. Q
  1. UPDATE ;
  1. S SRY1(SRFDA,SRIENU,".01")=SRASSD
  1. D UPDATE^DIE("","SRY1")
  1. Q
  1. FILE ;
  1. S SRY1(SRFDA,SRIENF,".01")=SRASSD
  1. D FILE^DIE("","SRY1")
  1. K SRY1
  1. Q
  1. PDELALL W !,"Are you sure you want to DELETE ALL Associated Diagnoses ? (Y/N) "
  1. S SRY(0)=Y(0)
  1. S %=2 D YN^DICN
  1. I %=1 Q:$E($G(IOST))'="C"!($G(DIK)'="") D KPADX^SROADX2(DA)
  1. S Y(0)=SRY(0)
  1. Q
  1. PDEL1 N SRC,SRY,SRY1,SRY2,REC,SRICD9,SRASSD ;DEL 1 PRIN ADX
  1. S (SRY,SRY0)=0
  1. F S SRY=$O(^SRF(SRTN,"PADX",SRY)) Q:'SRY S SRY0=SRY0+1,REC(SRY0)=SRY
  1. S SRY(0)=Y(0),SRFDA="130.275"
  1. F SRY2=1:1:SRDXCNT D
  1. .S SRY0=$P(SRY(0),",",SRY2)
  1. .Q:'SRY0
  1. .Q:'$D(REC(SRY0))
  1. .I SRY0=1,$P(^SRF(SRTN,"PADX",0),U,4)>1 K SRC S SRC(1)="PLEASE DELETE ALL DIAGNOSIS BEFORE THE PRINCIPAL",SRC(1,"F")="!!?5" D SRCWRT K SRC Q
  1. .S SRIENF=REC(SRY0)_","_SRTN_",",SRASSD="@"
  1. .W !,"Are you sure you want to DELETE ",SRTMP(SRY0)," ? (Y/N) "
  1. .S %=2 D YN^DICN
  1. .I %=1 D FILE
  1. S Y(0)=SRY(0)
  1. Q
  1. ODEL1 N SRY,SRY0,SRY1,SRY2,SRASSD ;DEL 1 OTH ADX
  1. S (SRY,SRY0)=0
  1. F S SRY=$O(^SRF(SRTN,13,OTH,"OADX",SRY)) Q:'SRY S SRY0=SRY0+1,REC(SRY0)=SRY
  1. S SRY(0)=Y(0),SRFDA="130.165"
  1. F SRY2=1:1:SRDXCNT D
  1. .S SRY0=$P(SRY(0),",",SRY2)
  1. .Q:'SRY0
  1. .S SRIENF=REC(SRY0)_","_OTH_","_SRTN_",",SRASSD="@"
  1. .W !,"Are you sure you want to DELETE ",SRTMP(SRY0)," ? (Y/N) "
  1. .Q:SRTMP(SRY0)=""
  1. .S %=2 D YN^DICN
  1. .I %=1 D FILE
  1. S Y(0)=SRY(0)
  1. Q
  1. OADDALL Q:$E($G(IOST))'="C"!($G(DIK)'="") D KOADX^SROADX2(SRTN,OTH) ;Associate all Diagnosis to OTHER Procedure
  1. N SRICD9,PADX,SRFDA,SRIENU,SRIENF,SRY,SRY1
  1. S SRY(0)=Y(0),SRFDA="130.165",SRIENU="+1"_","_OTH_","_SRTN_","
  1. S PADX=0
  1. F S PADX=$O(SRADIAG(PADX)) Q:'PADX S SRASSD=SRADIAG(PADX),SRIENF=PADX_","_OTH_","_SRTN_"," K SRY1 D UPDATE,FILE
  1. S Y(0)=SRY(0)
  1. Q
  1. OADD1 N SRY,SRY0,SRY1,SRY2,SRCNTR,SRASSD ;Associate 1 Diagnosis to OTHER Procedure
  1. S SRY(0)=Y(0),SRCNTR=0
  1. S:$D(^SRF(SRTN,13,OTH,"OADX")) SRCNTR=$P(^SRF(SRTN,13,OTH,"OADX",0),U,3)+1
  1. D KOADX^SROADX2(SRTN,OTH)
  1. S:'$D(^SRF(SRTN,13,OTH,"OADX")) SRCNTR=1
  1. S SRFDA="130.165",SRIENU="+1"_","_OTH_","_SRTN_","
  1. I SRDIRX(+Y)="ALL" D
  1. .S SRY0=0
  1. .F S SRY0=$O(SRADIAG(SRY0)) Q:'SRY0 D
  1. ..I '$D(^SRF(SRTN,13,OTH,"OADX","B",SRADIAG(SRY0))) D
  1. ..S SRASSD=SRADIAG(SRY0),SRIENF=SRCNTR_","_OTH_","_SRTN_"," K SRY1 D UPDATE,FILE
  1. ..S SRCNTR=SRCNTR+1
  1. I SRDIRX(+Y)'="ALL" D
  1. .F SRY2=1:1:$P(SRDX2,":",2) D
  1. ..S SRY0=$P(SRY(0),",",SRY2)
  1. ..Q:'SRY0
  1. ..S SRASSD=SRADIAG(SRY0),SRIENF=SRCNTR_","_OTH_","_SRTN_"," K SRY1 D UPDATE,FILE
  1. ..S SRCNTR=SRCNTR+1
  1. S Y(0)=SRY(0)
  1. Q
  1. SRCMSG S SRDX=X
  1. S SRC(1)="The Diagnosis/Procedure Code Association may no longer be correct,",SRC(1,"F")="!!?5"
  1. S SRC(2)="please confirm or update the values in the Diagnosis Association Field",SRC(2,"F")="!?5"
  1. Q
  1. SRCWRT D EN^DDIOL(.SRC)
  1. D CONT
  1. Q:$G(DTOUT)
  1. S:$D(SRDX) X=SRDX
  1. S SRFLG=1
  1. Q
  1. CONT N DIR
  1. S DIR(0)="FO^"
  1. S DIR("A")="Press RETURN to continue "
  1. D ^DIR
  1. Q
  1. ADXKILL K ADCNT,SRCOMMA,SRDXCNT,SROCNTR,SROCPT2,SROFLG,SRTMP,SRICD9,SRDIAGS
  1. K SRASDX,SRMSG,SRADX,SRPADX,SRODIR,REC,SRDIRX,SROANS
  1. Q