Changeset 1544 for ccr/trunk/p/C0CDIC.m


Ignore:
Timestamp:
Oct 1, 2012, 9:32:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Merged Routines in OHUM branch back in main tree

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p

  • ccr/trunk/p/C0CDIC.m

    r662 r1544  
    1 C0CDIC   ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
    2  ;;0.1;CCDCCR;nopatch;noreleasedate
    3  ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    4  ;General Public License See attached copy of the License.
    5  ;
    6  ;This program is free software; you can redistribute it and/or modify
    7  ;it under the terms of the GNU General Public License as published by
    8  ;the Free Software Foundation; either version 2 of the License, or
    9  ;(at your option) any later version.
    10  ;
    11  ;This program is distributed in the hope that it will be useful,
    12  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    13  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    14  ;GNU General Public License for more details.
    15  ;
    16  ;You should have received a copy of the GNU General Public License along
    17  ;with this program; if not, write to the Free Software Foundation, Inc.,
    18  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    19  ;
    20  W "This is the CCR Dictionary Utility Library ",!
    21  W !
    22  Q
    23  ;
    24 DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
    25  ;
    26  N ZI
    27  S ZI=""
    28  S G1=$NA(^TMP($J,"C0CCSV",1))
    29  S G1A=$NA(@G1@("V"))
    30  S G2=$NA(^TMP($J,"C0CCSV",2))
    31  D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
    32  F  S ZI=$O(@G1A@(ZI)) Q:ZI=""  D  ;FOR EACH ROW IN THE MATRIX
    33  . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D  ;
    34  . . W @G1A@(ZI,"MAPPING METHOD",1),!
    35  . . ;K @G1A@(ZI,"MAPPING METHOD")
    36  . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
    37  D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
    38  K @G1
    39  D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
    40  K @G2
    41  Q
    42  ;
    43 GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template
    44  ; and return them in C0CVARS, which is passed by name
    45  ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
    46  ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
    47  ; C0CT IS RETURNED AS THE CCR TEMPLATE
    48  N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
    49  D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
    50  D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
    51  N C0CI,C0CX
    52  S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
    53  F C0CI=1:1:C0CTVARS(0) D  ; FOR EVERY LINE IN THE ARRAY
    54  . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
    55  . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
    56  ;D PARY^GPLXPATH("C0CVARS")
    57  Q
    58  ;
    59 GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES
    60  ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
    61  ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
    62  ; BOTH ARE PASSED BY NAME
    63  ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
    64  ; C0CPVARS(0) IS NUMBER OF VARIABLES
    65  ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
    66  D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
    67  ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
    68  D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
    69  ; NOW GO GET THE XPATH INDEXES
    70  D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
    71  S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
    72  F  S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI=""  D  ; VISIT EVERY LINE
    73  . I +C0CI'=0 Q  ; SKIP EVERYTHING BUT THE XPATH INDEX
    74  . I C0CI=0 Q  ; SKIP THE ZERO NODE
    75  . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
    76  . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
    77  . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
    78  . I C0CY=C0CZ D  ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
    79  . . ; W "FOUND ",C0CI,!
    80  . . I $D(C0CTVARS(C0CY)) D  ; IF THERE IS A VARIABLE THERE
    81  . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
    82  D SORTV ; SORT THE ARRAY BY LINE NUMBER
    83  Q
    84  ;
    85 HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH
    86  ;N C0CI,C0CTVARS,C0CX,C0CY
    87  F C0CI=1:1:@C0CPVARS@(0) D  ; FOR THE ENTIRE ARRAY
    88  . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
    89  . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
    90  . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
    91  Q
    92  ;
    93 SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER
    94  ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
    95  S C0CI="" ;
    96  F  S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI=""  D  ; BY LINE NUMBER
    97  . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
    98  . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
    99  . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
    100  K @C0CPVARS
    101  M @C0CPVARS=C0C2
    102  Q
    103  ;
    104 LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
    105  ; INITIAL LOAD OF THE CCR DICTIONARY
    106  ;
    107  N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
    108  S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
    109  D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
    110  ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
    111  D PARY^GPLXPATH("C0CARY") ;TEST
    112  F C0CI=1:1:C0CARY(0) D  ; LOAD EACH VARIABLE
    113  . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
    114  . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
    115  . D UPDATE^DIE("","C0CFDA")
    116  . I $D(^TMP("DIERR",$J)) U $P BREAK
    117  . W "LOADING:",C0CI," ",C0CARY(C0CI),!
    118  Q
    119  ;
    120 INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
    121  ;
    122  ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,
    123  ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
    124  ;G1("CODING")="170^8"
    125  ;G1("DATA ELEMENT")="170^7"
    126  ;G1("DESCRIPTION")="170^3"
    127  ;G1("ID")="170^1"
    128  ;G1("M","170^8","CODING")="170.08^.01"
    129  ;G1("MAPPING METHOD")="170.08^1"
    130  ;G1("SECTION")="170^10"
    131  ;G1("SOURCE")="170^4"
    132  ;G1("STATUS")="170^9"
    133  ;G1("TYPE")="170^6"
    134  ;G1("VARIABLE")="170^.01"
    135  ;G1("XPATH")="170^2"
    136  ;
    137  N C0CZA,C0CZX,C0CN,C0CSTAT
    138  S C0CZX=0
    139  S C0CSTAT=0 ; INIT STATUS SET FLAG
    140  F  S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0  D  ; FOR EACH DICT ENTRY
    141  . ;W C0CZX,!
    142  . K C0CA,C0CN ; CLEAR OUT THE LAST ONE
    143  . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
    144  . ;ZWR C0CA B ;
    145  . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
    146  . W "VARIABLE: ",C0CN,!
    147  . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
    148  . I $E(C0CN,1,6)="SOCIAL" D  ;
    149  . . D SETFDA("SECTION","SOC") ;
    150  . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
    151  . . S C0CSTAT=1
    152  . I $E(C0CN,1,6)="FAMILY" D  ;
    153  . . D SETFDA("SECTION","FAM") ;
    154  . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
    155  . . S C0CSTAT=1
    156  . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
    157  . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
    158  . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
    159  . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
    160  . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
    161  . E  I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
    162  . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
    163  . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
    164  . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
    165  . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
    166  . I $$ZVALUE("XPATH")["/Medication/Directions/" D  ; MEDS DIRECTIONS VAR
    167  . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
    168  . E  I $$ZVALUE("XPATH")["/Medications/Medication/" D  ; ALL OTHER MEDS
    169  . . D SETFDA("SECTION","MEDS") ; A MEDS VAR
    170  . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
    171  . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
    172  . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
    173  . ;ZWR C0CFDA
    174  . I $D(C0CFDA) D  ; WE HAVE CHANGES ON THIS VARIABLE
    175  . . ;ZWR C0CFDA
    176  . . D UPDATE^DIE("","C0CFDA(C0CZX)")
    177  . . I $D(^TMP("DIERR",$J)) U $P BREAK
    178  . . D CLEAN^DILF ; CLEAN UP
    179  . ;ZWR C0CFDA
    180  Q
    181  ;
    182 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
    183  ; TO SET TO VALUE C0CSV.
    184  ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
    185  ; C0CSN,C0CSV ARE PASSED BY VALUE
    186  ;
    187  N C0CSI,C0CSJ
    188  S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
    189  S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
    190  S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
    191  Q
    192 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
    193  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
    194  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    195  I '$D(ZTAB) S ZTAB="C0CA"
    196  Q $P(@ZTAB@(ZFN),"^",1)
    197 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
    198  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
    199  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    200  I '$D(ZTAB) S ZTAB="C0CA"
    201  Q $P(@ZTAB@(ZFN),"^",2)
    202 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
    203  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
    204  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    205  I '$D(ZTAB) S ZTAB="C0CA"
    206  Q $P(@ZTAB@(ZFN),"^",3)
    207  ;
     1C0CDIC    ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
     2        ;;1.2;C0C;;May 11, 2012;Build 47
     3        ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
     4        ;General Public License See attached copy of the License.
     5        ;
     6        ;This program is free software; you can redistribute it and/or modify
     7        ;it under the terms of the GNU General Public License as published by
     8        ;the Free Software Foundation; either version 2 of the License, or
     9        ;(at your option) any later version.
     10        ;
     11        ;This program is distributed in the hope that it will be useful,
     12        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     13        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14        ;GNU General Public License for more details.
     15        ;
     16        ;You should have received a copy of the GNU General Public License along
     17        ;with this program; if not, write to the Free Software Foundation, Inc.,
     18        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     19        ;
     20        W "This is the CCR Dictionary Utility Library ",!
     21        W !
     22        Q
     23        ;
     24DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
     25        ;
     26        N ZI
     27        S ZI=""
     28        S G1=$NA(^TMP($J,"C0CCSV",1))
     29        S G1A=$NA(@G1@("V"))
     30        S G2=$NA(^TMP($J,"C0CCSV",2))
     31        D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
     32        F  S ZI=$O(@G1A@(ZI)) Q:ZI=""  D  ;FOR EACH ROW IN THE MATRIX
     33        . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D  ;
     34        . . W @G1A@(ZI,"MAPPING METHOD",1),!
     35        . . ;K @G1A@(ZI,"MAPPING METHOD")
     36        . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
     37        D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
     38        K @G1
     39        D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
     40        K @G2
     41        Q
     42        ;
     43GVARS(C0CVARS,C0CT)     ; Get the CCR variables from the CCR template
     44        ; and return them in C0CVARS, which is passed by name
     45        ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
     46        ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
     47        ; C0CT IS RETURNED AS THE CCR TEMPLATE
     48        N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
     49        D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
     50        D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
     51        N C0CI,C0CX
     52        S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
     53        F C0CI=1:1:C0CTVARS(0) D  ; FOR EVERY LINE IN THE ARRAY
     54        . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
     55        . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
     56        ;D PARY^GPLXPATH("C0CVARS")
     57        Q
     58        ;
     59GXPATH(C0CPVARS,C0CPT)  ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES
     60        ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
     61        ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
     62        ; BOTH ARE PASSED BY NAME
     63        ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
     64        ; C0CPVARS(0) IS NUMBER OF VARIABLES
     65        ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
     66        D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
     67        ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
     68        D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
     69        ; NOW GO GET THE XPATH INDEXES
     70        D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
     71        S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
     72        F  S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI=""  D  ; VISIT EVERY LINE
     73        . I +C0CI'=0 Q  ; SKIP EVERYTHING BUT THE XPATH INDEX
     74        . I C0CI=0 Q  ; SKIP THE ZERO NODE
     75        . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
     76        . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
     77        . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
     78        . I C0CY=C0CZ D  ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
     79        . . ; W "FOUND ",C0CI,!
     80        . . I $D(C0CTVARS(C0CY)) D  ; IF THERE IS A VARIABLE THERE
     81        . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
     82        D SORTV ; SORT THE ARRAY BY LINE NUMBER
     83        Q
     84        ;
     85HASHV   ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH
     86        ;N C0CI,C0CTVARS,C0CX,C0CY
     87        F C0CI=1:1:@C0CPVARS@(0) D  ; FOR THE ENTIRE ARRAY
     88        . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
     89        . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
     90        . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
     91        Q
     92        ;
     93SORTV   ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER
     94        ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
     95        S C0CI="" ;
     96        F  S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI=""  D  ; BY LINE NUMBER
     97        . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
     98        . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
     99        . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
     100        K @C0CPVARS
     101        M @C0CPVARS=C0C2
     102        Q
     103        ;
     104LOAD    ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
     105        ; INITIAL LOAD OF THE CCR DICTIONARY
     106        ;
     107        N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
     108        S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
     109        D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
     110        ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
     111        D PARY^GPLXPATH("C0CARY") ;TEST
     112        F C0CI=1:1:C0CARY(0) D  ; LOAD EACH VARIABLE
     113        . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
     114        . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
     115        . D UPDATE^DIE("","C0CFDA")
     116        . I $D(^TMP("DIERR",$J)) U $P BREAK
     117        . W "LOADING:",C0CI," ",C0CARY(C0CI),!
     118        Q
     119        ;
     120INIT    ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
     121        ;
     122        ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,
     123        ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
     124        ;G1("CODING")="170^8"
     125        ;G1("DATA ELEMENT")="170^7"
     126        ;G1("DESCRIPTION")="170^3"
     127        ;G1("ID")="170^1"
     128        ;G1("M","170^8","CODING")="170.08^.01"
     129        ;G1("MAPPING METHOD")="170.08^1"
     130        ;G1("SECTION")="170^10"
     131        ;G1("SOURCE")="170^4"
     132        ;G1("STATUS")="170^9"
     133        ;G1("TYPE")="170^6"
     134        ;G1("VARIABLE")="170^.01"
     135        ;G1("XPATH")="170^2"
     136        ;
     137        N C0CZA,C0CZX,C0CN,C0CSTAT
     138        S C0CZX=0
     139        S C0CSTAT=0 ; INIT STATUS SET FLAG
     140        F  S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0  D  ; FOR EACH DICT ENTRY
     141        . ;W C0CZX,!
     142        . K C0CA,C0CN ; CLEAR OUT THE LAST ONE
     143        . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
     144        . ;ZWR C0CA B ;
     145        . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
     146        . W "VARIABLE: ",C0CN,!
     147        . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
     148        . I $E(C0CN,1,6)="SOCIAL" D  ;
     149        . . D SETFDA("SECTION","SOC") ;
     150        . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
     151        . . S C0CSTAT=1
     152        . I $E(C0CN,1,6)="FAMILY" D  ;
     153        . . D SETFDA("SECTION","FAM") ;
     154        . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
     155        . . S C0CSTAT=1
     156        . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
     157        . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
     158        . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
     159        . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
     160        . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
     161        . E  I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
     162        . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
     163        . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
     164        . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
     165        . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
     166        . I $$ZVALUE("XPATH")["/Medication/Directions/" D  ; MEDS DIRECTIONS VAR
     167        . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
     168        . E  I $$ZVALUE("XPATH")["/Medications/Medication/" D  ; ALL OTHER MEDS
     169        . . D SETFDA("SECTION","MEDS") ; A MEDS VAR
     170        . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
     171        . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
     172        . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
     173        . ;ZWR C0CFDA
     174        . I $D(C0CFDA) D  ; WE HAVE CHANGES ON THIS VARIABLE
     175        . . ;ZWR C0CFDA
     176        . . D UPDATE^DIE("","C0CFDA(C0CZX)")
     177        . . I $D(^TMP("DIERR",$J)) U $P BREAK
     178        . . D CLEAN^DILF ; CLEAN UP
     179        . ;ZWR C0CFDA
     180        Q
     181        ;
     182SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
     183        ; TO SET TO VALUE C0CSV.
     184        ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
     185        ; C0CSN,C0CSV ARE PASSED BY VALUE
     186        ;
     187        N C0CSI,C0CSJ
     188        S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
     189        S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
     190        S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
     191        Q
     192ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
     193        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
     194        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     195        I '$D(ZTAB) S ZTAB="C0CA"
     196        Q $P(@ZTAB@(ZFN),"^",1)
     197ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
     198        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
     199        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     200        I '$D(ZTAB) S ZTAB="C0CA"
     201        Q $P(@ZTAB@(ZFN),"^",2)
     202ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
     203        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
     204        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     205        I '$D(ZTAB) S ZTAB="C0CA"
     206        Q $P(@ZTAB@(ZFN),"^",3)
     207        ;
Note: See TracChangeset for help on using the changeset viewer.