ICD0IDX ;DLS/DEK - MUMPS Cross Reference Routine for History ;28-Mar-2011 09:11;DU
;;18.0;DRG Grouper;**6,1003**;Oct 20, 2000;Build 2
;Modified - IHS/MSC/PLS - 03/28/2011 - Line SHIS+5
;
; ICDCOD ICD Code from Global
; ICDCODX ICD Code passed in (X)
; ICDEFF Effective Date
; ICDSTA Status
; ICDNOD Global Node (to reduce Global hits)
; DA ien file 80.1 or 80.166
; ICDIEN,DA(1) ien of file 80.1
; ICDHIS ien of file 80.166
; X Data passed in to be indexed
;
; Set and Kill Activation History
;
; File 80.1, field .01
SAHC ; Set new value when ICD Code is Edited
; ^DD(80.1,.01,1,D0,1) = D SAHC^ICD0IDX
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN
S ICDCODX=$G(X) Q:'$L(ICDCODX) S ICDIEN=+($G(DA)) Q:+ICDIEN'>0 Q:'$D(^ICD0(+ICDIEN,66))
S ICDHIS=0 F S ICDHIS=$O(^ICD0(+ICDIEN,66,ICDHIS)) Q:+ICDHIS=0 D
. N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
. S ICDCOD=ICDCODX Q:'$L($G(ICDCOD))
. Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) D SHIS
Q
KAHC ; Kill old value when ICD Code is Edited
; ^DD(80.1,.01,1,D0,2) = D KAHC^ICD0IDX
N ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN
S ICDCODX=$G(X) Q:'$L(ICDCODX) S ICDIEN=+($G(DA)) Q:+ICDIEN'>0 Q:'$D(^ICD0(+ICDIEN,66))
S ICDHIS=0 F S ICDHIS=$O(^ICD0(+ICDIEN,66,ICDHIS)) Q:+ICDHIS=0 D
. N DA,X S DA=+ICDHIS,DA(1)=+ICDIEN D HDC
. S ICDCOD=ICDCODX Q:'$L($G(ICDCOD))
. Q:'$L($G(ICDEFF)) Q:'$L($G(ICDSTA)) D KHIS
Q
;
; File 80.166, field .01
SAHD ; Set new value when Effective Date is Edited
; ^DD(80.166,.01,1,D0,1) = D SAHD^ICD0IDX
N ICDNOD,ICDSTA,ICDEFF,ICDCOD
D HDC Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA)) S ICDEFF=+($G(X)) Q:+ICDEFF=0 D SHIS
Q
KAHD ; Kill old value when Effective Date is Edited
; ^DD(80.166,.01,1,D0,2) = D KAHD^ICD0IDX
N ICDNOD,ICDSTA,ICDEFF,ICDCOD
D HDC Q:'$L($G(ICDCOD)) Q:'$L($G(ICDSTA))
S ICDEFF=+($G(X)) Q:+ICDEFF=0 D KHIS
Q
;
; File 80.166, field .02
SAHS ; Set new value when Status is Edited
; ^DD(80.166,.02,1,D0,1) = D SAHS^ICD0IDX
N ICDNOD,ICDSTA,ICDEFF,ICDCOD
D HDC Q:'$L($G(ICDCOD)) Q:+ICDEFF=0
S ICDSTA=$G(X) Q:'$L(ICDSTA) D SHIS
Q
KAHS ; Kill old value when Status is Edited
; ^DD(80.1.066,.02,1,D0,2) = D KAHS^ICD0IDX
N ICDNOD,ICDSTA,ICDEFF,ICDCOD
D HDC Q:'$L($G(ICDCOD)) Q:+ICDEFF=0
S ICDSTA=$G(X) Q:'$L(ICDSTA) D KHIS
Q
;
HDC ; Set Common Variables (Code, Status and Effective Date)
S (ICDCOD,ICDSTA,ICDEFF)=""
Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(^ICD0(+($G(DA(1))),66,+($G(DA)),0))
S ICDCOD=$P($G(^ICD0(+($G(DA(1))),0)),"^",1),ICDNOD=$G(^ICD0(+($G(DA(1))),66,+($G(DA)),0))
S ICDSTA=$P(ICDNOD,"^",2),ICDEFF=$P(ICDNOD,"^",1)
Q
;
SHIS ; Set Index ^ICD0("ACT",<code>,<status>,<date>,<ien>,<history>)
Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(^ICD0(+($G(DA(1))),66,+($G(DA)),0))
S ^ICD0("ACT",(ICDCOD_" "),ICDSTA,ICDEFF,DA(1),DA)=""
N PIECE,INACT S PIECE=$S('ICDSTA:11,1:12),INACT=$S('ICDSTA:1,1:"")
S $P(^ICD0(DA(1),0),"^",9)=INACT,$P(^ICD0(DA(1),0),"^",PIECE)=ICDEFF
;IHS/MSC/PLS - 03/28/2011 - New line
S:INACT="" $P(^ICD0(DA(1),0),"^",11)=""
Q
KHIS ; Kill Index ^ICD0("ACT",<code>,<status>,<date>,<ien>,<history>)
Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(^ICD0(+($G(DA(1))),66,+($G(DA)),0))
N PIECE,INACT,IEN,OPP,OPPSTA,OPPEFF,BOOL
S PIECE=$S('ICDSTA:11,1:12),INACT=$S('ICDSTA:"",1:1),OPPEFF=ICDEFF,BOOL=0
F S OPPEFF=$O(^ICD0(DA(1),66,"B",OPPEFF),-1) Q:'OPPEFF!BOOL D
. S IEN=$O(^ICD0(DA(1),66,"B",OPPEFF,""))
. I 'IEN S OPPEFF="" Q
. S OPP=$G(^ICD0(DA(1),66,IEN,0)),OPPEFF=$P($G(OPP),"^",1)
. S OPPSTA=$P($G(OPP),"^",2),BOOL=OPPSTA'=ICDSTA
I BOOL D
. S $P(^ICD0(DA(1),0),"^",9)=INACT,$P(^ICD0(DA(1),0),"^",PIECE)=$G(OPPEFF)
E S $P(^ICD0(DA(1),0),"^",9)=1,$P(^ICD0(DA(1),0),"^",11,12)="^"
K ^ICD0("ACT",(ICDCOD_" "),ICDSTA,ICDEFF,DA(1),DA)
Q
ICD0IDX ;DLS/DEK - MUMPS Cross Reference Routine for History ;28-Mar-2011 09:11;DU
+1 ;;18.0;DRG Grouper;**6,1003**;Oct 20, 2000;Build 2
+2 ;Modified - IHS/MSC/PLS - 03/28/2011 - Line SHIS+5
+3 ;
+4 ; ICDCOD ICD Code from Global
+5 ; ICDCODX ICD Code passed in (X)
+6 ; ICDEFF Effective Date
+7 ; ICDSTA Status
+8 ; ICDNOD Global Node (to reduce Global hits)
+9 ; DA ien file 80.1 or 80.166
+10 ; ICDIEN,DA(1) ien of file 80.1
+11 ; ICDHIS ien of file 80.166
+12 ; X Data passed in to be indexed
+13 ;
+14 ; Set and Kill Activation History
+15 ;
+16 ; File 80.1, field .01
SAHC ; Set new value when ICD Code is Edited
+1 ; ^DD(80.1,.01,1,D0,1) = D SAHC^ICD0IDX
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN
+3 SET ICDCODX=$GET(X)
IF '$LENGTH(ICDCODX)
QUIT
SET ICDIEN=+($GET(DA))
IF +ICDIEN'>0
QUIT
IF '$DATA(^ICD0(+ICDIEN,66))
QUIT
+4 SET ICDHIS=0
FOR
SET ICDHIS=$ORDER(^ICD0(+ICDIEN,66,ICDHIS))
IF +ICDHIS=0
QUIT
Begin DoDot:1
+5 NEW DA,X
SET DA=+ICDHIS
SET DA(1)=+ICDIEN
DO HDC
+6 SET ICDCOD=ICDCODX
IF '$LENGTH($GET(ICDCOD))
QUIT
+7 IF '$LENGTH($GET(ICDEFF))
QUIT
IF '$LENGTH($GET(ICDSTA))
QUIT
DO SHIS
End DoDot:1
+8 QUIT
KAHC ; Kill old value when ICD Code is Edited
+1 ; ^DD(80.1,.01,1,D0,2) = D KAHC^ICD0IDX
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD,ICDCODX,ICDHIS,ICDIEN
+3 SET ICDCODX=$GET(X)
IF '$LENGTH(ICDCODX)
QUIT
SET ICDIEN=+($GET(DA))
IF +ICDIEN'>0
QUIT
IF '$DATA(^ICD0(+ICDIEN,66))
QUIT
+4 SET ICDHIS=0
FOR
SET ICDHIS=$ORDER(^ICD0(+ICDIEN,66,ICDHIS))
IF +ICDHIS=0
QUIT
Begin DoDot:1
+5 NEW DA,X
SET DA=+ICDHIS
SET DA(1)=+ICDIEN
DO HDC
+6 SET ICDCOD=ICDCODX
IF '$LENGTH($GET(ICDCOD))
QUIT
+7 IF '$LENGTH($GET(ICDEFF))
QUIT
IF '$LENGTH($GET(ICDSTA))
QUIT
DO KHIS
End DoDot:1
+8 QUIT
+9 ;
+10 ; File 80.166, field .01
SAHD ; Set new value when Effective Date is Edited
+1 ; ^DD(80.166,.01,1,D0,1) = D SAHD^ICD0IDX
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD
+3 DO HDC
IF '$LENGTH($GET(ICDCOD))
QUIT
IF '$LENGTH($GET(ICDSTA))
QUIT
SET ICDEFF=+($GET(X))
IF +ICDEFF=0
QUIT
DO SHIS
+4 QUIT
KAHD ; Kill old value when Effective Date is Edited
+1 ; ^DD(80.166,.01,1,D0,2) = D KAHD^ICD0IDX
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD
+3 DO HDC
IF '$LENGTH($GET(ICDCOD))
QUIT
IF '$LENGTH($GET(ICDSTA))
QUIT
+4 SET ICDEFF=+($GET(X))
IF +ICDEFF=0
QUIT
DO KHIS
+5 QUIT
+6 ;
+7 ; File 80.166, field .02
SAHS ; Set new value when Status is Edited
+1 ; ^DD(80.166,.02,1,D0,1) = D SAHS^ICD0IDX
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD
+3 DO HDC
IF '$LENGTH($GET(ICDCOD))
QUIT
IF +ICDEFF=0
QUIT
+4 SET ICDSTA=$GET(X)
IF '$LENGTH(ICDSTA)
QUIT
DO SHIS
+5 QUIT
KAHS ; Kill old value when Status is Edited
+1 ; ^DD(80.1.066,.02,1,D0,2) = D KAHS^ICD0IDX
+2 NEW ICDNOD,ICDSTA,ICDEFF,ICDCOD
+3 DO HDC
IF '$LENGTH($GET(ICDCOD))
QUIT
IF +ICDEFF=0
QUIT
+4 SET ICDSTA=$GET(X)
IF '$LENGTH(ICDSTA)
QUIT
DO KHIS
+5 QUIT
+6 ;
HDC ; Set Common Variables (Code, Status and Effective Date)
+1 SET (ICDCOD,ICDSTA,ICDEFF)=""
+2 IF +($GET(DA(1)))'>0
QUIT
IF +($GET(DA))'>0
QUIT
IF '$DATA(^ICD0(+($GET(DA(1))),66,+($GET(DA)),0))
QUIT
+3 SET ICDCOD=$PIECE($GET(^ICD0(+($GET(DA(1))),0)),"^",1)
SET ICDNOD=$GET(^ICD0(+($GET(DA(1))),66,+($GET(DA)),0))
+4 SET ICDSTA=$PIECE(ICDNOD,"^",2)
SET ICDEFF=$PIECE(ICDNOD,"^",1)
+5 QUIT
+6 ;
SHIS ; Set Index ^ICD0("ACT",<code>,<status>,<date>,<ien>,<history>)
+1 IF +($GET(DA(1)))'>0
QUIT
IF +($GET(DA))'>0
QUIT
IF '$DATA(^ICD0(+($GET(DA(1))),66,+($GET(DA)),0))
QUIT
+2 SET ^ICD0("ACT",(ICDCOD_" "),ICDSTA,ICDEFF,DA(1),DA)=""
+3 NEW PIECE,INACT
SET PIECE=$SELECT('ICDSTA:11,1:12)
SET INACT=$SELECT('ICDSTA:1,1:"")
+4 SET $PIECE(^ICD0(DA(1),0),"^",9)=INACT
SET $PIECE(^ICD0(DA(1),0),"^",PIECE)=ICDEFF
+5 ;IHS/MSC/PLS - 03/28/2011 - New line
+6 IF INACT=""
SET $PIECE(^ICD0(DA(1),0),"^",11)=""
+7 QUIT
KHIS ; Kill Index ^ICD0("ACT",<code>,<status>,<date>,<ien>,<history>)
+1 IF +($GET(DA(1)))'>0
QUIT
IF +($GET(DA))'>0
QUIT
IF '$DATA(^ICD0(+($GET(DA(1))),66,+($GET(DA)),0))
QUIT
+2 NEW PIECE,INACT,IEN,OPP,OPPSTA,OPPEFF,BOOL
+3 SET PIECE=$SELECT('ICDSTA:11,1:12)
SET INACT=$SELECT('ICDSTA:"",1:1)
SET OPPEFF=ICDEFF
SET BOOL=0
+4 FOR
SET OPPEFF=$ORDER(^ICD0(DA(1),66,"B",OPPEFF),-1)
IF 'OPPEFF!BOOL
QUIT
Begin DoDot:1
+5 SET IEN=$ORDER(^ICD0(DA(1),66,"B",OPPEFF,""))
+6 IF 'IEN
SET OPPEFF=""
QUIT
+7 SET OPP=$GET(^ICD0(DA(1),66,IEN,0))
SET OPPEFF=$PIECE($GET(OPP),"^",1)
+8 SET OPPSTA=$PIECE($GET(OPP),"^",2)
SET BOOL=OPPSTA'=ICDSTA
End DoDot:1
+9 IF BOOL
Begin DoDot:1
+10 SET $PIECE(^ICD0(DA(1),0),"^",9)=INACT
SET $PIECE(^ICD0(DA(1),0),"^",PIECE)=$GET(OPPEFF)
End DoDot:1
+11 IF '$TEST
SET $PIECE(^ICD0(DA(1),0),"^",9)=1
SET $PIECE(^ICD0(DA(1),0),"^",11,12)="^"
+12 KILL ^ICD0("ACT",(ICDCOD_" "),ICDSTA,ICDEFF,DA(1),DA)
+13 QUIT
