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

ICDIDX2.m

Go to the documentation of this file.
  1. ICDIDX2 ;DLS/DEK - MUMPS Cross Reference Routine for History ;04/21/2014
  1. ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
  1. ;
  1. ; Global Variables
  1. ; None
  1. ;
  1. ; External References
  1. ; None
  1. ;
  1. ; Common Variables used:
  1. ;
  1. ; ICDCOD ICD Code from Global
  1. ; ICDCODX ICD Code passed in (X)
  1. ; ICDEFF Effective Date
  1. ; ICDSTA Status
  1. ; ICDNOD Global Node (to reduce Global hits)
  1. ; DA IEN file 80, 80.1, 80.066 or 80.166
  1. ; ICDIEN,DA(1) IEN of file 80 or 80.1
  1. ; ICDHIS IEN of file 80.066 or 80.166
  1. ; X Data passed in to be indexed
  1. ;
  1. Q
  1. SAHC(ICD) ; Code .01 ACT1 Set
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT,EXC
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
  1. S ICDCODX=$G(X) Q:'$L(ICDCODX) S ICDIEN=+($G(DA)) Q:+ICDIEN'>0
  1. Q:'$D(@(RT_+ICDIEN_",66)"))
  1. S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
  1. . N DA,ICDSYS,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
  1. . S ICDCOD=ICDCODX Q:'$L($G(ICDCOD))
  1. . Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) K ICDSYS D SHIS
  1. . S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 SHIS
  1. Q
  1. KAHC(ICD) ; Code .01 ACT1 Kill
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S ICDCODX=$G(X) Q:'$L(ICDCODX)
  1. S ICDIEN=+($G(DA)) Q:+ICDIEN'>0 Q:'$D(@(RT_+ICDIEN_",66)"))
  1. S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
  1. . N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
  1. . S ICDCOD=ICDCODX Q:'$L($G(ICDCOD))
  1. . Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) K ICDSYS D KHIS
  1. . S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 KHIS
  1. Q
  1. SAHD(ICD) ; Effective Date 66,.01 ACT2 Set
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA(1))),RT) Q:+EXC'>0
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS
  1. D HDC Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) S ICDEFF=+($G(X)) Q:+ICDEFF=0 K ICDSYS D SHIS
  1. S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 SHIS
  1. Q
  1. KAHD(ICD) ; Effective Date 66,.01 ACT2 Kill
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) D HDC Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA))
  1. S ICDEFF=+($G(X)) Q:+ICDEFF=0 K ICDSYS D KHIS
  1. S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 KHIS
  1. Q
  1. SAHS(ICD) ; Status 66,.02 ACT3 Set
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS,RT,EXC
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA(1))),RT) Q:+EXC'>0
  1. D HDC Q:'$L($G(ICDCOD)) Q:+ICDEFF=0
  1. S ICDSTA=$G(X) Q:'$L(ICDSTA) K ICDSYS D SHIS
  1. S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 SHIS
  1. Q
  1. KAHS(ICD) ; Status 66,.02 ACT3 Kill
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDSYS,ICDSYS,RT
  1. S RT=$$RT($G(ICD)) Q:'$L(RT)
  1. D HDC Q:'$L($G(ICDCOD)) Q:+ICDEFF=0
  1. S ICDSTA=$G(X) Q:'$L(ICDSTA) K ICDSYS D KHIS
  1. S ICDSYS=+($P($G(@(RT_+($G(DA(1)))_",1)")),"^",1)) D:+ICDSYS>0 KHIS
  1. Q
  1. SAHCS(ICD) ; Coding System 1.1 ACT4 Set
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT,EXC
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
  1. S ICDSYS=$G(X) Q:'$L(ICDSYS) S ICDIEN=+($G(DA)) Q:+ICDIEN'>0
  1. S EXC=$$EXC(DA) Q:+EXC'>0 Q:'$D(@(RT_+ICDIEN_",66)"))
  1. S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
  1. . N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
  1. . S ICDCOD=$P($G(@(RT_+ICDIEN_",0)")),"^",1) Q:'$L($G(ICDCOD))
  1. . Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) D SHIS
  1. Q
  1. KAHCS(ICD) ; Coding System 1.1 ACT4 Kill
  1. N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN,ICDSYS,RT
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S ICDSYS=$G(X) Q:'$L(ICDSYS)
  1. S ICDIEN=+($G(DA)) Q:+ICDIEN'>0 Q:'$D(@(RT_+ICDIEN_",66)"))
  1. S ICDHIS=0 F S ICDHIS=$O(@(RT_+ICDIEN_",66,"_ICDHIS_")")) Q:+ICDHIS=0 D
  1. . N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
  1. . S ICDCOD=$P($G(@(RT_+ICDIEN_",0)")),"^",1) Q:'$L($G(ICDCOD))
  1. . Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) D KHIS
  1. Q
  1. SNUM(ICD) ; Code .01 AN1 Set
  1. N RT,EXC,NUM,SYS
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
  1. S SYS=+($P($G(@(RT_+DA_",1)")),"^",1)) Q:+SYS'>0
  1. Q:'$L($G(X)) Q:+($G(DA))'>0
  1. S NUM=$$NUM^ICDEX(X) Q:+NUM'>0
  1. S @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")=""
  1. Q
  1. KNUM(ICD) ; Code .01 AN1 Kill
  1. N RT,NUM,SYS
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S SYS=+($P($G(@(RT_+DA_",1)")),"^",1)) Q:+SYS'>0
  1. Q:'$L($G(X)) Q:+($G(DA))'>0 S NUM=$$NUM^ICDEX(X) Q:+NUM'>0
  1. K @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")
  1. Q
  1. SNUM2(ICD) ; Coding System 1.1 AN2 Set
  1. N RT,EXC,NUM,SYS,COD S SYS=+($G(X)) Q:+SYS'>0 Q:+($G(DA))'>0
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S EXC=$$EXC(+($G(DA)),RT) Q:+EXC'>0
  1. S COD=$P($G(@(RT_+DA_",0)")),"^",1) Q:'$L(COD)
  1. S NUM=$$NUM^ICDEX(COD) Q:+NUM'>0
  1. S @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")=""
  1. Q
  1. KNUM2(ICD) ; Coding System 1.1 AN2 Kill
  1. N RT,EXC,NUM,SYS,COD S SYS=+($G(X)) Q:+SYS'>0 Q:+($G(DA))'>0
  1. S RT=$$RT($G(ICD)) Q:'$L(RT) S COD=$P($G(@(RT_+DA_",0)")),"^",1)
  1. Q:'$L(COD) S NUM=$$NUM^ICDEX(COD) Q:+NUM'>0
  1. K @(RT_""""_"AN"_+SYS_""","_+NUM_","_+DA_")")
  1. Q
  1. SSYS(ICD) ; Coding System - Static
  1. Q
  1. KSYS(ICD) ; Coding System - Static
  1. Q
  1. ;
  1. ; Miscellaneous
  1. HDC ; Set Common Variables (Code, Status and Effective Date)
  1. Q:'$L($G(RT)) S (ICDCOD,ICDSTA,ICDEFF)="" Q:'$L($G(RT))
  1. Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
  1. S ICDCOD=$P($G(@(RT_+($G(DA(1)))_",0)")),"^",1),ICDNOD=$G(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
  1. S ICDSTA=$P(ICDNOD,"^",2),ICDEFF=$P(ICDNOD,"^",1)
  1. Q
  1. SHIS ; Set ^ROOT("ACT",<code>,<status>,<date>,<ien>,<history>)
  1. ; Set ^ROOT("ACTS",<sys>,<code>,<status>,<date>,<ien>,<history>)
  1. Q:'$L($G(RT)) N EXC Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0
  1. Q:'$D(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
  1. Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) Q:'$L($G(ICDEFF))
  1. S @(RT_"""ACT"","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
  1. S:+($G(ICDSYS))>0 @(RT_"""ACTS"","_+ICDSYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
  1. I +($G(ICDSYS))'>0 D
  1. . N SYS S SYS=+($P($G(@(RT_+DA(1)_",1)")),"^",1))
  1. . S:+SYS>0 @(RT_"""ACTS"","_+SYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")=""
  1. Q
  1. KHIS ; Kill ^ROOT("ACT",<code>,<status>,<date>,<ien>,<history>)
  1. ; Kill ^ROOT("ACTS",<sys>,<code>,<status>,<date>,<ien>,<history>)
  1. Q:'$L($G(RT)) Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(@(RT_+($G(DA(1)))_",66,"_+($G(DA))_",0)"))
  1. Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) Q:'$L($G(ICDEFF))
  1. K @(RT_"""ACT"","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
  1. K:+($G(ICDSYS))>0 @(RT_"""ACTS"","_+ICDSYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
  1. I +($G(ICDSYS))'>0 D
  1. . N SYS S SYS=+($P($G(@(RT_+DA(1)_",1)")),"^",1))
  1. . K:+SYS>0 @(RT_"""ACTS"","_+SYS_","""_(ICDCOD_" ")_""","_+ICDSTA_","_+ICDEFF_","_+DA(1)_","_+DA_")")
  1. Q
  1. EXC(X,Y) ; Exclude from lookup
  1. N COD,EFF,LDS,IEN,RT S IEN=+($G(X)),RT=$G(Y) Q:+IEN'>0 0 Q:'$L(RT) 0 S COD=$P($G(@(RT_+IEN_",0)")),"^",1)
  1. S EFF=$O(@(RT_+IEN_",66,0)")),LDS=$O(@(RT_+IEN_",68,0)")) Q:$L(COD)&(+EFF>0)&(+LDS>0) 1
  1. Q 0
  1. RT(X) ; Root from File #
  1. Q $S(+($G(X))=80:$$ROOT^ICDEX(80),+($G(X))=80.1:$$ROOT^ICDEX(80.1),1:"")