DVB4P66A ;ALB/MJB/RC - DISABILITY FILE UPDATE ; 11/16/10 3:56pm
;;4.0;HINQ;**66**;03/25/92;Build 14
;
;This routine is the post-install driver that will map DISABILITY
;CONDITIONS in the DISABILITY CONDITION (#31) file with 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 update the 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("DVB4P66",$J,"ADDICD")) K @DVBTMP
;
;loop each routine
;F DVBCNT=1:1:2 S DVBRTN="^DVB464P"_DVBCNT D
;. Q:($T(@DVBRTN)="")
;. D BLDXRF(DVBRTN,DVBTMP,.DVBTOT)
D BLDXRF("DVB4P66A",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 incrementer
N DVBTAG ;line tag of routine to process
N DVBVBA ;VBA DX code (external value)
N DVBVB ;DX CODE
;
S (DVBLN,DVBVBA)=0
;
F DVBLN=1:1 S DVBTAG="TEXT+"_DVBLN_U_DVBRTN,DVBLINE=$T(@DVBTAG) S DVBVB=$P(DVBLINE,";",3,999) Q:DVBLINE["EXIT" D
.;get VBA DX CODE var setup
.S DVBVBA=$P(DVBVB,"^",1)
.;S DVBVBA=$P(DVBVB,"^",1),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 Q
.;
.D BLDVBA(DVBVBA,DVBLINE,.DVBTOT)
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 are multiple VBA iens setup
I DVBVBA'="" S DVBIEN=0
F S DVBIEN=$O(^DIC(31,"C",DVBVBA,DVBIEN)) Q:DVBIEN="" D
. S DVBX=$P(DVBVB,"^",1)
. S (DVBI,DVBICD)=0
. F DVBI=1:1 S DVBDATA=$P(DVBX,"^",DVBI) Q:DVBDATA="" D
. . Q:DVBDATA[";"
. . S DVBICD=$P(DVBVB,"^",2),DVBMATCH=+$P(DVBVB,"^",3)
. . ; - get ICD9 pointer from ICD DIAGNOSIS (#80) file
. . S DVBICDEN=+$$ICDDX^ICDCODE(DVBICD,DT)
. . I 'DVBICDEN!(DVBICDEN<0)!(DVBICD=DVBICDEN) 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 add 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
;
; Fields :
; (#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,DIC,DIE,DA,DR
S DVBRSLT=0
;
I $G(DVBIEN),$G(DVBICDEN),$G(DVBMATCH)]"" D
.S DA(1)=DVBIEN
.S DA=$O(^DIC(31,DA(1),"ICD","B",DVBICDEN,0))
.I DA'>0 D Q:DA'>0
..W !!,"ADDING TO DISABILITY CODE "_DVBVBA_""
..W !!,"ADDING ICD CODE "_DVBICD_" TO MAPPING"
..S DIC="^DIC(31,"_DA(1)_",""ICD"",",DIC(0)="L",DIC("P")="31.01PA",DLAYGO=31.01
..S X=DVBICDEN
..K DD,DO D FILE^DICN
..S DA=+Y
..K DIC,DLAYGO,X,Y
.;
.S DIE="^DIC(31,"_DA(1)_",""ICD"","
.S DR=".02///^S X=DVBMATCH"
.D ^DIE
.S:'$D(DVBERR) DVBRSLT=1
Q DVBRSLT
;
; Fields :
; (#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 and related ICD9 DIAGNOSIS code to be
;mapped together. Each IDC9 code also has a (1/0)
;match value that will be filed with it.
;
;DISABILITY CODE^ICDCODE^MATCH - FULL(1) OR PARTIAL(0)
TEXT ;
;;7705^287.41^1
;;7705^287.49^1
;;5238^724.03^0
;;7332^787.60^1
;;7332^787.61^1
;;7332^787.62^1
;;7332^787.63^1
;;8045^780.33^1
;;8861^389.9^1
;;8867^011.90^0
;;8882^352.9^0
;;8883^352.9^0
;;8884^352.9^0
;;8886^356.9^0
;;8887^356.9^0
;;8889^345.90^0
;;8892^298.9^1
;;8893^310.9^1
;;8894^300.9^1
;;8895^306.9^1
;;9007^298.9^1
;;EXIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVB4P66A 5531 printed Dec 13, 2024@01:57:51 Page 2
DVB4P66A ;ALB/MJB/RC - DISABILITY FILE UPDATE ; 11/16/10 3:56pm
+1 ;;4.0;HINQ;**66**;03/25/92;Build 14
+2 ;
+3 ;This routine is the post-install driver that will map DISABILITY
+4 ;CONDITIONS in the DISABILITY CONDITION (#31) file with ICD
+5 ;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 update the 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("DVB4P66",$JOB,"ADDICD"))
KILL @DVBTMP
+16 ;
+17 ;loop each routine
+18 ;F DVBCNT=1:1:2 S DVBRTN="^DVB464P"_DVBCNT D
+19 ;. Q:($T(@DVBRTN)="")
+20 ;. D BLDXRF(DVBRTN,DVBTMP,.DVBTOT)
+21 DO BLDXRF("DVB4P66A",DVBTMP,.DVBTOT)
+22 QUIT
+23 ;
+24 ;
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 incrementer
NEW DVBLN
+12 ;line tag of routine to process
NEW DVBTAG
+13 ;VBA DX code (external value)
NEW DVBVBA
+14 ;DX CODE
NEW DVBVB
+15 ;
+16 SET (DVBLN,DVBVBA)=0
+17 ;
+18 FOR DVBLN=1:1
SET DVBTAG="TEXT+"_DVBLN_U_DVBRTN
SET DVBLINE=$TEXT(@DVBTAG)
SET DVBVB=$PIECE(DVBLINE,";",3,999)
if DVBLINE["EXIT"
QUIT
Begin DoDot:1
+19 ;get VBA DX CODE var setup
+20 SET DVBVBA=$PIECE(DVBVB,"^",1)
+21 ;S DVBVBA=$P(DVBVB,"^",1),DVBLN=DVBLN+1
+22 ; - if code not found setup ^TMP() file error record
+23 IF '$ORDER(^DIC(31,"C",DVBVBA,""))
Begin DoDot:2
+24 SET @DVBTMP@("ERROR",DVBVBA)="DX CODE not found in (#31) file"
+25 SET DVBVBA=0
+26 ;
End DoDot:2
+27 ;quit back to loop if no VBA code ien found (just in case)
+28 IF 'DVBVBA
QUIT
+29 ;
+30 DO BLDVBA(DVBVBA,DVBLINE,.DVBTOT)
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 are multiple VBA iens setup
+16 IF DVBVBA'=""
SET DVBIEN=0
+17 FOR
SET DVBIEN=$ORDER(^DIC(31,"C",DVBVBA,DVBIEN))
if DVBIEN=""
QUIT
Begin DoDot:1
+18 SET DVBX=$PIECE(DVBVB,"^",1)
+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(DVBVB,"^",2)
SET DVBMATCH=+$PIECE(DVBVB,"^",3)
+23 ; - get ICD9 pointer from ICD DIAGNOSIS (#80) file
+24 SET DVBICDEN=+$$ICDDX^ICDCODE(DVBICD,DT)
+25 IF 'DVBICDEN!(DVBICDEN<0)!(DVBICD=DVBICDEN)
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 add 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 ; Fields :
+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,DIC,DIE,DA,DR
+18 SET DVBRSLT=0
+19 ;
+20 IF $GET(DVBIEN)
IF $GET(DVBICDEN)
IF $GET(DVBMATCH)]""
Begin DoDot:1
+21 SET DA(1)=DVBIEN
+22 SET DA=$ORDER(^DIC(31,DA(1),"ICD","B",DVBICDEN,0))
+23 IF DA'>0
Begin DoDot:2
+24 WRITE !!,"ADDING TO DISABILITY CODE "_DVBVBA_""
+25 WRITE !!,"ADDING ICD CODE "_DVBICD_" TO MAPPING"
+26 SET DIC="^DIC(31,"_DA(1)_",""ICD"","
SET DIC(0)="L"
SET DIC("P")="31.01PA"
SET DLAYGO=31.01
+27 SET X=DVBICDEN
+28 KILL DD,DO
DO FILE^DICN
+29 SET DA=+Y
+30 KILL DIC,DLAYGO,X,Y
End DoDot:2
if DA'>0
QUIT
+31 ;
+32 SET DIE="^DIC(31,"_DA(1)_",""ICD"","
+33 SET DR=".02///^S X=DVBMATCH"
+34 DO ^DIE
+35 if '$DATA(DVBERR)
SET DVBRSLT=1
End DoDot:1
+36 QUIT DVBRSLT
+37 ;
+38 ; Fields :
+39 ; (#20) RELATED ICD9 CODES - ICD;0 POINTER Multiple (#31.01)
+40 ; (#31.01) -- RELATED ICD9 CODES SUB-FILE
+41 ; Field(s):
+42 ; .01 RELATED ICD9 CODES - 0;1 POINTER TO ICD DIAGNOSIS FILE (#80)
+43 ; .02 ICD9 MATCH - 0;2 SET ('0' FOR PARTIAL MATCH; '1' FOR MATCH;)
+44 ;
+45 ;The following TEXT lines are a combination of a single 4 digit VBA
+46 ;rated disabilities code and related ICD9 DIAGNOSIS code to be
+47 ;mapped together. Each IDC9 code also has a (1/0)
+48 ;match value that will be filed with it.
+49 ;
+50 ;DISABILITY CODE^ICDCODE^MATCH - FULL(1) OR PARTIAL(0)
TEXT ;
+1 ;;7705^287.41^1
+2 ;;7705^287.49^1
+3 ;;5238^724.03^0
+4 ;;7332^787.60^1
+5 ;;7332^787.61^1
+6 ;;7332^787.62^1
+7 ;;7332^787.63^1
+8 ;;8045^780.33^1
+9 ;;8861^389.9^1
+10 ;;8867^011.90^0
+11 ;;8882^352.9^0
+12 ;;8883^352.9^0
+13 ;;8884^352.9^0
+14 ;;8886^356.9^0
+15 ;;8887^356.9^0
+16 ;;8889^345.90^0
+17 ;;8892^298.9^1
+18 ;;8893^310.9^1
+19 ;;8894^300.9^1
+20 ;;8895^306.9^1
+21 ;;9007^298.9^1
+22 ;;EXIT
