DVB458P1 ;ALB/RBS - POST-INSTALL FOR PATCH DVB*4*58 (CONT.) ; 4/24/07 3:53pm
;;4.0;HINQ;**58**;03/25/92;Build 29
;
;This routine is the main post-install driver that will update the
;DISABILITY CONDITION (#31) file with the new mapping of Rated
;Disabilities (VA) VBA DX CODES to specific ICD DIAGNOSIS codes.
;
Q ;no direct entry
;
POST(DVBTMP,DVBTOT) ;post-install driver for updating the (#31) file
;This procedure will call a series of routines that contain the data
;element values that will be used to create the new VBA-ICD9 mapping.
;
; Input:
; DVBTMP - Closed Root global reference for error reporting
; DVBTOT - Total number of ICD9 codes filed
;
; Output:
; DVBTMP - Temp file of error messages (if any)
; DVBTOT - Total number of ICD9 codes filed
;
N DVBRTN,DVBCNT
S DVBTMP=$G(DVBTMP)
S DVBTOT=$G(DVBTOT) I DVBTOT']"" S DVBTOT=0
I DVBTMP']"" S DVBTMP=$NA(^TMP("DVB458P",$J)) K @DVBTMP
;
;loop each routine
F DVBCNT=1:1:6 S DVBRTN="^DVB458P"_DVBCNT D
. Q:($T(@DVBRTN)="")
. D BLDXRF(DVBRTN,DVBTMP,.DVBTOT)
Q
;
;
BLDXRF(DVBRTN,DVBTMP,DVBTOT) ;call each routine to file VBA/ICD9 codes
;
; Input:
; DVBRTN - Post Install routine to process VBA/ICD9 codes
; DVBTMP - Closed Root global reference for error reporting
; DVBTOT - Total number of ICD9 codes filed
;
; Output:
; DVBTOT - Total number of ICD9 codes filed
;
N DVBLINE ;$TEXT code line
N DVBLN ;line counter incrimenter
N DVBTAG ;line tag of routine to process
N DVBVBA ;VBA DX code (external value)
;
S (DVBLN,DVBVBA)=0
;
F S DVBTAG="TEXT+"_DVBLN_DVBRTN,DVBLINE=$T(@DVBTAG) Q:DVBLINE["$EXIT" D
. ;get VBA DX CODE var setup
. I DVBLINE'["~" D Q
. . S DVBVBA=$P(DVBLINE,";",3),DVBLN=DVBLN+1
. . ; - if code not found setup ^TMP() file error record
. . I '$O(^DIC(31,"C",DVBVBA,"")) D
. . . S @DVBTMP@("ERROR",DVBVBA)="DX CODE not found in (#31) file"
. . . S DVBVBA=0
. ;
. ;quit back to loop if no VBA code ien found (just in case)
. I 'DVBVBA S DVBLN=DVBLN+1 Q
. ;
. D BLDVBA(DVBVBA,DVBLINE,.DVBTOT)
. S DVBLN=DVBLN+1
Q
;
;
BLDVBA(DVBVBA,DVBLINE,DVBTOT) ;extract ICD9 codes from text line
;
; Input:
; DVBVBA - VBA DX code (external value)
; DVBLINE - $TEXT code line of ICD9's
; DVBTOT - Total number of ICD9 codes filed
;
; Output:
; DVBTOT - Total number of ICD9 codes filed
;
Q:'$G(DVBVBA)
Q:$G(DVBLINE)']""
;
N DVBDATA,DVBI,DVBICD,DVBICDEN,DVBIEN,DVBMATCH,DVBX
;
;loop in case there might be multiple VBA ien's setup
S DVBIEN=0
F S DVBIEN=$O(^DIC(31,"C",DVBVBA,DVBIEN)) Q:DVBIEN="" D
. S DVBX=$P(DVBLINE,";",3,999)
. S (DVBI,DVBICD)=0
. F DVBI=1:1 S DVBDATA=$P(DVBX,"^",DVBI) Q:DVBDATA="" D
. . Q:DVBDATA[";"
. . S DVBICD=$P(DVBDATA,"~"),DVBMATCH=+$P(DVBDATA,"~",2)
. . ; - get ICD9 pointer from ICD DIAGNOSIS (#80) file
. . S DVBICDEN=+$$ICDDX^ICDCODE(DVBICD)
. . I ('DVBICDEN)!(DVBICDEN<0) D Q
. . . S @DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD)="not found in ICD DIAGNOSIS (#80) file"
. . ;
. . Q:$D(^DIC(31,DVBIEN,"ICD","B",DVBICDEN)) ;ICD9 already setup
. . ;
. . ;call to create new multiple field (#20) RELATED ICD9 CODES
. . I '$$FILEICD(DVBIEN,DVBICDEN,DVBMATCH) D Q
. . . S @DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD)="error filing to (#31) file"
. . S DVBTOT=DVBTOT+1
Q
;
;
FILEICD(DVBIEN,DVBICDEN,DVBMATCH) ;file code mapping to (#31) file
;
; Input:
; DVBIEN - ien of VBA DX CODE in file (#31)
; DVBICDEN - ien of ICD9 code in file (#80)
; DVBMATCH - match code (1 or 0)
;
; Output:
; Function result - 1 on success, 0 on failure
;
; New Fields created:
; (#20) RELATED ICD9 CODES - ICD;0 POINTER Multiple (#31.01)
; (#31.01) -- RELATED ICD9 CODES SUB-FILE
; Field(s):
; .01 RELATED ICD9 CODES - 0;1 POINTER TO ICD DIAGNOSIS FILE (#80)
; .02 ICD9 MATCH - 0;2 SET ('0' FOR PARTIAL MATCH; '1' FOR MATCH;)
;
N DVBERR,DVBFDA,DVBRSLT
S DVBRSLT=0
;
I $G(DVBIEN),$G(DVBICDEN),$G(DVBMATCH)]"" D
. K DVBFDA,DVBERR
. S DVBFDA(31,"?+1,",.01)=DVBIEN
. S DVBFDA(31.01,"+2,?+1,",.01)=DVBICDEN
. S DVBFDA(31.01,"+2,?+1,",.02)=DVBMATCH
. D UPDATE^DIE("","DVBFDA","","DVBERR")
. S:'$D(DVBERR) DVBRSLT=1
Q DVBRSLT
;
;
;FOR TESTING ONLY
DELETE ;delete (#20) field sub-file (#31.01) ICD9 entries
;
N DVBIEN,CNT
N DA,DIC,DIK,X,Y
;
;delete all ICD9 entries first
S (CNT,DVBIEN)=0
F S DVBIEN=$O(^DIC(31,DVBIEN)) Q:DVBIEN="" D
. I $O(^DIC(31,DVBIEN,"ICD",0)) D
. . S DA(1)=DVBIEN,DIK="^DIC(31,"_DA(1)_",""ICD"",",DA=0,CNT=CNT+1
. . I CNT=1 D BMES^XPDUTL(" >>> *** Removing data from field #20 in the DISABILITY CONDITION (#31) file... "),MES^XPDUTL(" ")
. . F S DA=$O(^DIC(31,DA(1),"ICD",DA)) Q:'DA D ^DIK
. . ;
. . ;now kill the (#20) RELATED ICD9 CODES field node
. . I '$O(^DIC(31,DA(1),"ICD",0)) K ^DIC(31,DA(1),"ICD",0)
Q
;
;
;NOTE:
;The DISABILITY CONDITION FILE (#31) will have a new multiple field
;added that will contain the Rated Disabilities (VA) field DX CODE
;mapping of a specific ICD9 diagnosis code and a Match code value.
;
; New Fields created:
; (#20) RELATED ICD9 CODES - ICD;0 POINTER Multiple (#31.01)
; (#31.01) -- RELATED ICD9 CODES SUB-FILE
; Field(s):
; .01 RELATED ICD9 CODES - 0;1 POINTER TO ICD DIAGNOSIS FILE (#80)
; .02 ICD9 MATCH - 0;2 SET ('0' FOR PARTIAL MATCH; '1' FOR MATCH;)
;
;The following TEXT lines are a combination of a single 4 digit VBA
;rated disabilities code (DX CODE) on one line followed by on the
;next sequential line(s), all of the related ICD9 DIAGNOSIS codes
;that are to be mapped together. Each IDC9 code also has a (1/0)
;match value that will be filed with it.
;
;Example:
; ;;5000 = a single (VBA) Rated Disabilities (VA) DX CODE
; ;;003.24~1^376.03~1^730.00~1^... = string of ICD9 DIAGNOSIS CODES
; (delimited by (^) up-arrow)
; Each (^) piece contains 2 pieces of data delimited by (~):
; $P(1) = a single ICD9 diagnosis code
; $P(2) = (1/0) match code value
;
; Note: If the TEXT line ends with a (;) semi-colon, this means the
; next sequential line is associated with the same DX CODE.
; (No sequential line(s) are carried over to the next
; post-install Routine.)
;
TEXT ;;5000
;;003.24~0^376.03~0^730.00~0^730.01~0^730.02~0^730.03~0^730.04~0^730.05~0^730.06~0^730.07~0^730.08~0^730.09~1^730.10~0^730.11~0^730.12~0^730.13~0^730.14~0^730.15~0^730.16~0^730.17~0^730.18~0^730.19~1^;
;;730.20~0^730.21~0^730.22~0^730.23~0^730.24~0^730.25~0^730.26~0^730.27~0^730.28~0^730.29~1
;;5001
;;015.00~0^015.01~0^015.02~0^015.03~0^015.04~0^015.05~0^015.06~0^015.10~0^015.11~0^015.12~0^015.13~0^015.14~0^015.15~0^015.16~0^015.20~0^015.21~0^015.22~0^015.23~0^015.24~0^015.25~0^015.26~0^015.50~0^;
;;015.51~0^015.52~0^015.53~0^015.54~0^015.55~0^015.56~0^015.60~0^015.61~0^015.62~0^015.63~0^015.64~0^015.65~0^015.66~0^015.70~0^015.71~0^015.72~0^015.73~0^015.74~0^015.75~0^015.76~0^015.80~0^015.81~0^;
;;015.82~0^015.83~0^015.84~0^015.85~0^015.86~0^015.90~0^015.91~0^015.92~0^015.93~0^015.94~0^015.95~0^015.96~0
;;5002
;;714.0~0^714.1~0^714.2~0^714.30~0^714.31~0^714.32~0^714.33~0^714.4~0
;;5003
;;715.00~0^715.04~0^715.09~0^715.10~0^715.11~0^715.12~0^715.13~0^715.14~0^715.15~0^715.16~0^715.17~0^715.18~0^715.20~0^715.21~0^715.22~0^715.23~0^715.24~0^715.25~0^715.26~0^715.27~0^715.28~0^715.30~0^;
;;715.31~0^715.32~0^715.33~0^715.34~0^715.35~0^715.36~0^715.37~0^715.38~0^715.80~0^715.89~0^715.90~0^715.91~0^715.92~0^715.93~0^715.94~0^715.95~0^715.96~0^715.97~0^715.98~0
;;5004
;;098.50~0
;;$EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVB458P1 7774 printed Nov 22, 2024@17:07:49 Page 2
DVB458P1 ;ALB/RBS - POST-INSTALL FOR PATCH DVB*4*58 (CONT.) ; 4/24/07 3:53pm
+1 ;;4.0;HINQ;**58**;03/25/92;Build 29
+2 ;
+3 ;This routine is the main post-install driver that will update the
+4 ;DISABILITY CONDITION (#31) file with the new mapping of Rated
+5 ;Disabilities (VA) VBA DX CODES to specific ICD DIAGNOSIS codes.
+6 ;
+7 ;no direct entry
QUIT
+8 ;
POST(DVBTMP,DVBTOT) ;post-install driver for updating the (#31) file
+1 ;This procedure will call a series of routines that contain the data
+2 ;element values that will be used to create the new VBA-ICD9 mapping.
+3 ;
+4 ; Input:
+5 ; DVBTMP - Closed Root global reference for error reporting
+6 ; DVBTOT - Total number of ICD9 codes filed
+7 ;
+8 ; Output:
+9 ; DVBTMP - Temp file of error messages (if any)
+10 ; DVBTOT - Total number of ICD9 codes filed
+11 ;
+12 NEW DVBRTN,DVBCNT
+13 SET DVBTMP=$GET(DVBTMP)
+14 SET DVBTOT=$GET(DVBTOT)
IF DVBTOT']""
SET DVBTOT=0
+15 IF DVBTMP']""
SET DVBTMP=$NAME(^TMP("DVB458P",$JOB))
KILL @DVBTMP
+16 ;
+17 ;loop each routine
+18 FOR DVBCNT=1:1:6
SET DVBRTN="^DVB458P"_DVBCNT
Begin DoDot:1
+19 if ($TEXT(@DVBRTN)="")
QUIT
+20 DO BLDXRF(DVBRTN,DVBTMP,.DVBTOT)
End DoDot:1
+21 QUIT
+22 ;
+23 ;
BLDXRF(DVBRTN,DVBTMP,DVBTOT) ;call each routine to file VBA/ICD9 codes
+1 ;
+2 ; Input:
+3 ; DVBRTN - Post Install routine to process VBA/ICD9 codes
+4 ; DVBTMP - Closed Root global reference for error reporting
+5 ; DVBTOT - Total number of ICD9 codes filed
+6 ;
+7 ; Output:
+8 ; DVBTOT - Total number of ICD9 codes filed
+9 ;
+10 ;$TEXT code line
NEW DVBLINE
+11 ;line counter incrimenter
NEW DVBLN
+12 ;line tag of routine to process
NEW DVBTAG
+13 ;VBA DX code (external value)
NEW DVBVBA
+14 ;
+15 SET (DVBLN,DVBVBA)=0
+16 ;
+17 FOR
SET DVBTAG="TEXT+"_DVBLN_DVBRTN
SET DVBLINE=$TEXT(@DVBTAG)
if DVBLINE["$EXIT"
QUIT
Begin DoDot:1
+18 ;get VBA DX CODE var setup
+19 IF DVBLINE'["~"
Begin DoDot:2
+20 SET DVBVBA=$PIECE(DVBLINE,";",3)
SET DVBLN=DVBLN+1
+21 ; - if code not found setup ^TMP() file error record
+22 IF '$ORDER(^DIC(31,"C",DVBVBA,""))
Begin DoDot:3
+23 SET @DVBTMP@("ERROR",DVBVBA)="DX CODE not found in (#31) file"
+24 SET DVBVBA=0
End DoDot:3
End DoDot:2
QUIT
+25 ;
+26 ;quit back to loop if no VBA code ien found (just in case)
+27 IF 'DVBVBA
SET DVBLN=DVBLN+1
QUIT
+28 ;
+29 DO BLDVBA(DVBVBA,DVBLINE,.DVBTOT)
+30 SET DVBLN=DVBLN+1
End DoDot:1
+31 QUIT
+32 ;
+33 ;
BLDVBA(DVBVBA,DVBLINE,DVBTOT) ;extract ICD9 codes from text line
+1 ;
+2 ; Input:
+3 ; DVBVBA - VBA DX code (external value)
+4 ; DVBLINE - $TEXT code line of ICD9's
+5 ; DVBTOT - Total number of ICD9 codes filed
+6 ;
+7 ; Output:
+8 ; DVBTOT - Total number of ICD9 codes filed
+9 ;
+10 if '$GET(DVBVBA)
QUIT
+11 if $GET(DVBLINE)']""
QUIT
+12 ;
+13 NEW DVBDATA,DVBI,DVBICD,DVBICDEN,DVBIEN,DVBMATCH,DVBX
+14 ;
+15 ;loop in case there might be multiple VBA ien's setup
+16 SET DVBIEN=0
+17 FOR
SET DVBIEN=$ORDER(^DIC(31,"C",DVBVBA,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:1
+18 SET DVBX=$PIECE(DVBLINE,";",3,999)
+19 SET (DVBI,DVBICD)=0
+20 FOR DVBI=1:1
SET DVBDATA=$PIECE(DVBX,"^",DVBI)
if DVBDATA=""
QUIT
Begin DoDot:2
+21 if DVBDATA[";"
QUIT
+22 SET DVBICD=$PIECE(DVBDATA,"~")
SET DVBMATCH=+$PIECE(DVBDATA,"~",2)
+23 ; - get ICD9 pointer from ICD DIAGNOSIS (#80) file
+24 SET DVBICDEN=+$$ICDDX^ICDCODE(DVBICD)
+25 IF ('DVBICDEN)!(DVBICDEN<0)
Begin DoDot:3
+26 SET @DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD)="not found in ICD DIAGNOSIS (#80) file"
End DoDot:3
QUIT
+27 ;
+28 ;ICD9 already setup
if $DATA(^DIC(31,DVBIEN,"ICD","B",DVBICDEN))
QUIT
+29 ;
+30 ;call to create new multiple field (#20) RELATED ICD9 CODES
+31 IF '$$FILEICD(DVBIEN,DVBICDEN,DVBMATCH)
Begin DoDot:3
+32 SET @DVBTMP@("ERROR",DVBVBA,DVBIEN,DVBICD)="error filing to (#31) file"
End DoDot:3
QUIT
+33 SET DVBTOT=DVBTOT+1
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
+36 ;
FILEICD(DVBIEN,DVBICDEN,DVBMATCH) ;file code mapping to (#31) file
+1 ;
+2 ; Input:
+3 ; DVBIEN - ien of VBA DX CODE in file (#31)
+4 ; DVBICDEN - ien of ICD9 code in file (#80)
+5 ; DVBMATCH - match code (1 or 0)
+6 ;
+7 ; Output:
+8 ; Function result - 1 on success, 0 on failure
+9 ;
+10 ; New Fields created:
+11 ; (#20) RELATED ICD9 CODES - ICD;0 POINTER Multiple (#31.01)
+12 ; (#31.01) -- RELATED ICD9 CODES SUB-FILE
+13 ; Field(s):
+14 ; .01 RELATED ICD9 CODES - 0;1 POINTER TO ICD DIAGNOSIS FILE (#80)
+15 ; .02 ICD9 MATCH - 0;2 SET ('0' FOR PARTIAL MATCH; '1' FOR MATCH;)
+16 ;
+17 NEW DVBERR,DVBFDA,DVBRSLT
+18 SET DVBRSLT=0
+19 ;
+20 IF $GET(DVBIEN)
IF $GET(DVBICDEN)
IF $GET(DVBMATCH)]""
Begin DoDot:1
+21 KILL DVBFDA,DVBERR
+22 SET DVBFDA(31,"?+1,",.01)=DVBIEN
+23 SET DVBFDA(31.01,"+2,?+1,",.01)=DVBICDEN
+24 SET DVBFDA(31.01,"+2,?+1,",.02)=DVBMATCH
+25 DO UPDATE^DIE("","DVBFDA","","DVBERR")
+26 if '$DATA(DVBERR)
SET DVBRSLT=1
End DoDot:1
+27 QUIT DVBRSLT
+28 ;
+29 ;
+30 ;FOR TESTING ONLY
DELETE ;delete (#20) field sub-file (#31.01) ICD9 entries
+1 ;
+2 NEW DVBIEN,CNT
+3 NEW DA,DIC,DIK,X,Y
+4 ;
+5 ;delete all ICD9 entries first
+6 SET (CNT,DVBIEN)=0
+7 FOR
SET DVBIEN=$ORDER(^DIC(31,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:1
+8 IF $ORDER(^DIC(31,DVBIEN,"ICD",0))
Begin DoDot:2
+9 SET DA(1)=DVBIEN
SET DIK="^DIC(31,"_DA(1)_",""ICD"","
SET DA=0
SET CNT=CNT+1
+10 IF CNT=1
DO BMES^XPDUTL(" >>> *** Removing data from field #20 in the DISABILITY CONDITION (#31) file... ")
DO MES^XPDUTL(" ")
+11 FOR
SET DA=$ORDER(^DIC(31,DA(1),"ICD",DA))
if 'DA
QUIT
DO ^DIK
+12 ;
+13 ;now kill the (#20) RELATED ICD9 CODES field node
+14 IF '$ORDER(^DIC(31,DA(1),"ICD",0))
KILL ^DIC(31,DA(1),"ICD",0)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+17 ;
+18 ;NOTE:
+19 ;The DISABILITY CONDITION FILE (#31) will have a new multiple field
+20 ;added that will contain the Rated Disabilities (VA) field DX CODE
+21 ;mapping of a specific ICD9 diagnosis code and a Match code value.
+22 ;
+23 ; New Fields created:
+24 ; (#20) RELATED ICD9 CODES - ICD;0 POINTER Multiple (#31.01)
+25 ; (#31.01) -- RELATED ICD9 CODES SUB-FILE
+26 ; Field(s):
+27 ; .01 RELATED ICD9 CODES - 0;1 POINTER TO ICD DIAGNOSIS FILE (#80)
+28 ; .02 ICD9 MATCH - 0;2 SET ('0' FOR PARTIAL MATCH; '1' FOR MATCH;)
+29 ;
+30 ;The following TEXT lines are a combination of a single 4 digit VBA
+31 ;rated disabilities code (DX CODE) on one line followed by on the
+32 ;next sequential line(s), all of the related ICD9 DIAGNOSIS codes
+33 ;that are to be mapped together. Each IDC9 code also has a (1/0)
+34 ;match value that will be filed with it.
+35 ;
+36 ;Example:
+37 ; ;;5000 = a single (VBA) Rated Disabilities (VA) DX CODE
+38 ; ;;003.24~1^376.03~1^730.00~1^... = string of ICD9 DIAGNOSIS CODES
+39 ; (delimited by (^) up-arrow)
+40 ; Each (^) piece contains 2 pieces of data delimited by (~):
+41 ; $P(1) = a single ICD9 diagnosis code
+42 ; $P(2) = (1/0) match code value
+43 ;
+44 ; Note: If the TEXT line ends with a (;) semi-colon, this means the
+45 ; next sequential line is associated with the same DX CODE.
+46 ; (No sequential line(s) are carried over to the next
+47 ; post-install Routine.)
+48 ;
TEXT ;;5000
+1 ;;003.24~0^376.03~0^730.00~0^730.01~0^730.02~0^730.03~0^730.04~0^730.05~0^730.06~0^730.07~0^730.08~0^730.09~1^730.10~0^730.11~0^730.12~0^730.13~0^730.14~0^730.15~0^730.16~0^730.17~0^730.18~0^730.19~1^;
+2 ;;730.20~0^730.21~0^730.22~0^730.23~0^730.24~0^730.25~0^730.26~0^730.27~0^730.28~0^730.29~1
+3 ;;5001
+4 ;;015.00~0^015.01~0^015.02~0^015.03~0^015.04~0^015.05~0^015.06~0^015.10~0^015.11~0^015.12~0^015.13~0^015.14~0^015.15~0^015.16~0^015.20~0^015.21~0^015.22~0^015.23~0^015.24~0^015.25~0^015.26~0^015.50~0^;
+5 ;;015.51~0^015.52~0^015.53~0^015.54~0^015.55~0^015.56~0^015.60~0^015.61~0^015.62~0^015.63~0^015.64~0^015.65~0^015.66~0^015.70~0^015.71~0^015.72~0^015.73~0^015.74~0^015.75~0^015.76~0^015.80~0^015.81~0^;
+6 ;;015.82~0^015.83~0^015.84~0^015.85~0^015.86~0^015.90~0^015.91~0^015.92~0^015.93~0^015.94~0^015.95~0^015.96~0
+7 ;;5002
+8 ;;714.0~0^714.1~0^714.2~0^714.30~0^714.31~0^714.32~0^714.33~0^714.4~0
+9 ;;5003
+10 ;;715.00~0^715.04~0^715.09~0^715.10~0^715.11~0^715.12~0^715.13~0^715.14~0^715.15~0^715.16~0^715.17~0^715.18~0^715.20~0^715.21~0^715.22~0^715.23~0^715.24~0^715.25~0^715.26~0^715.27~0^715.28~0^715.30~0^;
+11 ;;715.31~0^715.32~0^715.33~0^715.34~0^715.35~0^715.36~0^715.37~0^715.38~0^715.80~0^715.89~0^715.90~0^715.91~0^715.92~0^715.93~0^715.94~0^715.95~0^715.96~0^715.97~0^715.98~0
+12 ;;5004
+13 ;;098.50~0
+14 ;;$EXIT
