Routine: DVB4P66A

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)

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)

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

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  Feb 18, 2025@23:24:13                                                                                                                                                                                                    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

DVB4P66A.m