Changeset 1204 for ccr/trunk/p/C0CFM2.m


Ignore:
Timestamp:
Jun 23, 2011, 3:01:41 PM (13 years ago)
Author:
George Lilly
Message:

updates for MU Certification

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CFM2.m

    r572 r1204  
    11C0CFM2    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
    2  ;;1.0;C0C;;May 19, 2009;
    3  ;Copyright 2009 George Lilly.  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 FILEMAN Utility Library ",!
    21  ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
    22  ; CCR ELEMENTS (^C0C(179.201,
    23  ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
    24  ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
    25  ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
    26  ; ALL SUB-VARIABLES HAVE BEEN REMOVED
    27  W !
    28  Q
    29  ;
     2        ;;1.0;C0C;;May 19, 2009;Build 38
     3        ;Copyright 2009 George Lilly.  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 FILEMAN Utility Library ",!
     21        ; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
     22        ; CCR ELEMENTS (^C0C(179.201,
     23        ; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
     24        ; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
     25        ; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
     26        ; ALL SUB-VARIABLES HAVE BEEN REMOVED
     27        W !
     28        Q
     29        ;
    3030RIMTBL(ZWHICH)  ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
    31  ;
    32  I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
    33  N ZI,ZJ,ZC,ZPATBASE
    34  S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
    35  S ZI=""
    36  F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
    37  . S ZI=$O(@ZPATBASE@(ZI))
    38  . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
    39  Q
    40  ;
     31        ;
     32        I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
     33        N ZI,ZJ,ZC,ZPATBASE
     34        S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
     35        S ZI=""
     36        F ZJ=0:0 D  Q:$O(@ZPATBASE@(ZI))=""  ; TIL END
     37        . S ZI=$O(@ZPATBASE@(ZI))
     38        . D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
     39        Q
     40        ;
    4141PUTRIM(DFN,ZWHICH)      ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
    42  ;
    43  S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
    44  I '$D(ZWHICH) S ZWHICH="ALL"
    45  I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
    46  . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
    47  . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
    48  E  D  ; MULTIPLE SECTIONS
    49  . S C0CVARS=$NA(@C0CGLB)
    50  . S C0CI=""
    51  . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
    52  . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
    53  . . D PUTRIM1(DFN,C0CI,C0CVARSN)
    54  Q
    55  ;
     42        ;
     43        S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
     44        I '$D(ZWHICH) S ZWHICH="ALL"
     45        I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
     46        . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
     47        . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
     48        E  D  ; MULTIPLE SECTIONS
     49        . S C0CVARS=$NA(@C0CGLB)
     50        . S C0CI=""
     51        . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
     52        . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
     53        . . D PUTRIM1(DFN,C0CI,C0CVARSN)
     54        Q
     55        ;
    5656PUTRIM1(DFN,ZZTYP,ZVARS)        ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
    57  ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
    58  S C0CX=0
    59  F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
    60  . W "ZOCC=",C0CX,!
    61  . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
    62  . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
    63  . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
    64  . I $D(C0CMDO) D  ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
    65  . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
    66  . . S ZZCNT=0
    67  . . S ZZC0CI=0
    68  . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
    69  . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
    70  . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
    71  . . W "MULTIPLE:",ZZVALS,!
    72  . . ;B
    73  . . F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
    74  . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
    75  . . . W "COUNT:",ZZCNT,!
    76  . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
    77  . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
    78  Q
    79  ;
     57        ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
     58        S C0CX=0
     59        F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
     60        . W "ZOCC=",C0CX,!
     61        . K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
     62        . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
     63        . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
     64        . I $D(C0CMDO) D  ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
     65        . . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
     66        . . S ZZCNT=0
     67        . . S ZZC0CI=0
     68        . . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
     69        . . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
     70        . . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
     71        . . W "MULTIPLE:",ZZVALS,!
     72        . . ;B
     73        . . F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
     74        . . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
     75        . . . W "COUNT:",ZZCNT,!
     76        . . . S ZV=$NA(@ZZVALS@(ZZC0CI))
     77        . . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
     78        Q
     79        ;
    8080PUTELS(DFN,ZTYPE,ZOCC,ZVALS)    ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
    81  ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
    82  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
    83  ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
    84  ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
    85  ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
    86  ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
    87  ;
    88  N PATN,ZTYPN,XD0,ZTYP
    89  I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET
    90  ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
    91  N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL
    92  N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
    93  N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
    94  N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
    95  N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
    96  ;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
    97  ; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
    98  N C0CFDA
    99  S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
    100  D UPDIE ; ADD THE PATIENT
    101  S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
    102  S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
    103  D UPDIE ; ADD THE CCR SOURCE
    104  N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
    105  S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
    106  D UPDIE ; ADD THE ELEMENT TYPE
    107  S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
    108  S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
    109  ; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
    110  ; STRING COLLATION ON THE INDEX
    111  D UPDIE ; ADD THE OCCURANCE
    112  S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,""))
    113  W "RECORD NUMBER: ",ZD0,!
    114  ;I ZD0=32 B
    115  ;I ZD0=31 B
    116  N ZCNT,ZC0CI,ZVARN,C0CZ1
    117  S ZCNT=0
    118  S ZC0CI="" ;
    119  F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
    120  . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
    121  . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
    122  . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
    123  . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
    124  . . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
    125  . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
    126  . . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
    127  . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
    128  . E  D  ; THIS IS A SUBELEMENT
    129  . . ;PUT THE FOLLOWING BACK TO USE RECURSION
    130  . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
    131  . . ;S ZZCNT=0
    132  . . ;S ZZC0CI=0
    133  . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
    134  . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
    135  . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
    136  . . ;W "MULTIPLE:",ZZVALS,!
    137  . . ;B
    138  . . ;F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
    139  . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
    140  . . ;. W "COUNT:",ZZCNT,!
    141  . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
    142  . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
    143  . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
    144  D UPDIE ; UPDATE
    145  Q
    146  ;
     81        ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
     82        ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
     83        ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
     84        ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
     85        ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
     86        ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
     87        ;
     88        N PATN,ZTYPN,XD0,ZTYP
     89        I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET
     90        ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
     91        N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL
     92        N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
     93        N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
     94        N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
     95        N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
     96        ;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
     97        ; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
     98        N C0CFDA
     99        S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
     100        D UPDIE ; ADD THE PATIENT
     101        S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
     102        S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
     103        D UPDIE ; ADD THE CCR SOURCE
     104        N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
     105        S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
     106        D UPDIE ; ADD THE ELEMENT TYPE
     107        S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
     108        S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
     109        ; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
     110        ; STRING COLLATION ON THE INDEX
     111        D UPDIE ; ADD THE OCCURANCE
     112        S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,""))
     113        W "RECORD NUMBER: ",ZD0,!
     114        ;I ZD0=32 B
     115        ;I ZD0=31 B
     116        N ZCNT,ZC0CI,ZVARN,C0CZ1
     117        S ZCNT=0
     118        S ZC0CI="" ;
     119        F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
     120        . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
     121        . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
     122        . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
     123        . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
     124        . . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
     125        . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
     126        . . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
     127        . . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
     128        . E  D  ; THIS IS A SUBELEMENT
     129        . . ;PUT THE FOLLOWING BACK TO USE RECURSION
     130        . . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
     131        . . ;S ZZCNT=0
     132        . . ;S ZZC0CI=0
     133        . . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
     134        . . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
     135        . . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
     136        . . ;W "MULTIPLE:",ZZVALS,!
     137        . . ;B
     138        . . ;F  S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI=""  D  ; EACH MULTIPLE
     139        . . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
     140        . . ;. W "COUNT:",ZZCNT,!
     141        . . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
     142        . . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
     143        . . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
     144        D UPDIE ; UPDATE
     145        Q
     146        ;
    147147UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    148  K ZERR
    149  D CLEAN^DILF
    150  D UPDATE^DIE("","C0CFDA","","ZERR")
    151  I $D(ZERR) D  ;
    152  . W "ERROR",!
    153  . ZWR ZERR
    154  . B
    155  K C0CFDA
    156  Q
    157  ;
     148        K ZERR
     149        D CLEAN^DILF
     150        D UPDATE^DIE("","C0CFDA","","ZERR")
     151        I $D(ZERR) D  ;
     152        . W "ERROR",!
     153        . ZWR ZERR
     154        . B
     155        K C0CFDA
     156        Q
     157        ;
    158158CHECK   ; CHECKSUM EXPERIMENTS
    159  ;
    160  ;B
    161  S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
    162  ;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
    163  S X=$$CHKSUM^XUSESIG1(ZG)
    164  W G1,!
    165  Q
    166  ;
     159        ;
     160        ;B
     161        S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
     162        ;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
     163        S X=$$CHKSUM^XUSESIG1(ZG)
     164        W G1,!
     165        Q
     166        ;
    167167CHKELS(DFN)     ; CHECKSUM ALL ELEMENTS FOR  A PATIENT
    168  ;
    169  S ZGLB=$NA(^TMP("C0CCHK"))
    170  S ZPAT=$O(^C0CE("B",DFN,""))
    171  K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
    172  S ZSRC=""
    173  F  S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC=""  D  ;
    174  . W "PAT:",ZPAT," SRC:",ZSRC,!
    175  . S ZEL=""
    176  . F  S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL=""  D  ;ELEMENTS
    177  . . W "ELEMENT:",ZEL," "
    178  . . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
    179  . . W ZELE," "
    180  . . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
    181  . . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
    182  . . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
    183  . . W ZCHK,!
    184  . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
    185  ZWR ^TMP("C0CCHK",ZPAT,*)
    186  Q
    187  ;
     168        ;
     169        S ZGLB=$NA(^TMP("C0CCHK"))
     170        S ZPAT=$O(^C0CE("B",DFN,""))
     171        K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
     172        S ZSRC=""
     173        F  S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC=""  D  ;
     174        . W "PAT:",ZPAT," SRC:",ZSRC,!
     175        . S ZEL=""
     176        . F  S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL=""  D  ;ELEMENTS
     177        . . W "ELEMENT:",ZEL," "
     178        . . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
     179        . . W ZELE," "
     180        . . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
     181        . . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
     182        . . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
     183        . . W ZCHK,!
     184        . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
     185        ZWR ^TMP("C0CCHK",ZPAT,*)
     186        Q
     187        ;
    188188DOIT(DFN)       ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
    189  D SETXUP
    190  D CHKELS(DFN)
    191  Q
    192  ;
     189        D SETXUP
     190        D CHKELS(DFN)
     191        Q
     192        ;
    193193SETXUP  ; SET UP ENVIRONMENT
    194  S DISYS=19
    195  S DT=3090325
    196  S DTIME=300
    197  S DUZ=1
    198  S DUZ(0)="@"
    199  S DUZ(1)=""
    200  S DUZ(2)=7247
    201  S DUZ("AG")="I"
    202  S DUZ("BUF")=1
    203  S DUZ("LANG")=""
    204  S IO="/dev/pts/20"
    205  S IO(0)="/dev/pts/20"
    206  S IO(1,"/dev/pts/20")=""
    207  S IO("ERROR")=""
    208  S IO("HOME")="344^/dev/pts/20"
    209  S IO("ZIO")="/dev/pts/20"
    210  S IOBS="$C(8)"
    211  S IOF="#,$C(27,91,50,74,27,91,72)"
    212  S IOM=80
    213  S ION="TELNET"
    214  S IOS=344
    215  S IOSL=24
    216  S IOST="C-VT100"
    217  S IOST(0)=9
    218  S IOT="VTRM"
    219  S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
    220  S U="^"
    221  S X="216;DIC(4.2,"
    222  S XPARSYS="216;DIC(4.2,"
    223  S XQXFLG="^^XUP"
    224  Q
    225  ;
     194        S DISYS=19
     195        S DT=3090325
     196        S DTIME=300
     197        S DUZ=1
     198        S DUZ(0)="@"
     199        S DUZ(1)=""
     200        S DUZ(2)=7247
     201        S DUZ("AG")="I"
     202        S DUZ("BUF")=1
     203        S DUZ("LANG")=""
     204        S IO="/dev/pts/20"
     205        S IO(0)="/dev/pts/20"
     206        S IO(1,"/dev/pts/20")=""
     207        S IO("ERROR")=""
     208        S IO("HOME")="344^/dev/pts/20"
     209        S IO("ZIO")="/dev/pts/20"
     210        S IOBS="$C(8)"
     211        S IOF="#,$C(27,91,50,74,27,91,72)"
     212        S IOM=80
     213        S ION="TELNET"
     214        S IOS=344
     215        S IOSL=24
     216        S IOST="C-VT100"
     217        S IOST(0)=9
     218        S IOT="VTRM"
     219        S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
     220        S U="^"
     221        S X="216;DIC(4.2,"
     222        S XPARSYS="216;DIC(4.2,"
     223        S XQXFLG="^^XUP"
     224        Q
     225        ;
    226226PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
    227  ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
    228  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
    229  ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
    230  ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
    231  ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
    232  ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
    233  ;
    234  S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
    235  ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
    236  N ZF,ZFV S ZF=171.101 S ZFV=171.1011
    237  ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
    238  ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
    239  N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
    240  W "ZTYPE: ",ZTYPE," ",ZTYPN,!
    241  N ZVARN ; IEN OF VARIABLE BEING PROCESSED
    242  ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
    243  K C0CFDA
    244  S C0CFDA(ZF,"?+1,",.01)=DFN
    245  S C0CFDA(ZF,"?+1,",.02)=ZSRC
    246  S C0CFDA(ZF,"?+1,",.03)=ZTYPN
    247  S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
    248  K ZERR
    249  ;B
    250  D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
    251  I $D(ZERR) B  ;OOPS
    252  K C0CFDA
    253  S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
    254  W "RECORD NUMBER: ",ZD0,!
    255  ;B
    256  S ZCNT=0
    257  S ZC0CI="" ;
    258  F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
    259  . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
    260  . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
    261  . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
    262  . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
    263  . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
    264  . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
    265  . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
    266  . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
    267  ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
    268  ;S GT1(170,"?+1,",12)="DIR"
    269  ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
    270  ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
    271  D CLEAN^DILF
    272  D UPDATE^DIE("","C0CFDA","","ZERR")
    273  I $D(ZERR) D  ;
    274  . W "ERROR",!
    275  . ZWR ZERR
    276  . B
    277  K C0CFDA
    278  Q
    279  ;
     227        ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
     228        ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
     229        ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
     230        ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
     231        ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
     232        ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
     233        ;
     234        S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
     235        ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
     236        N ZF,ZFV S ZF=171.101 S ZFV=171.1011
     237        ;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
     238        ;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
     239        N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
     240        W "ZTYPE: ",ZTYPE," ",ZTYPN,!
     241        N ZVARN ; IEN OF VARIABLE BEING PROCESSED
     242        ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
     243        K C0CFDA
     244        S C0CFDA(ZF,"?+1,",.01)=DFN
     245        S C0CFDA(ZF,"?+1,",.02)=ZSRC
     246        S C0CFDA(ZF,"?+1,",.03)=ZTYPN
     247        S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
     248        K ZERR
     249        ;B
     250        D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
     251        I $D(ZERR) B  ;OOPS
     252        K C0CFDA
     253        S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
     254        W "RECORD NUMBER: ",ZD0,!
     255        ;B
     256        S ZCNT=0
     257        S ZC0CI="" ;
     258        F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
     259        . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
     260        . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
     261        . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
     262        . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
     263        . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
     264        . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
     265        . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
     266        . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
     267        ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
     268        ;S GT1(170,"?+1,",12)="DIR"
     269        ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
     270        ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
     271        D CLEAN^DILF
     272        D UPDATE^DIE("","C0CFDA","","ZERR")
     273        I $D(ZERR) D  ;
     274        . W "ERROR",!
     275        . ZWR ZERR
     276        . B
     277        K C0CFDA
     278        Q
     279        ;
    280280VARPTR(ZVAR,ZTYP)       ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
    281  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
    282  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
    283  ;
    284  N ZCCRD,ZVARN,C0CFDA2
    285  S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
    286  S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
    287  I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
    288  . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
    289  . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
    290  . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
    291  . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
    292  . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
    293  . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
    294  . I $D(ZERR) D  ; LAYGO ERROR
    295  . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
    296  . E  D  ;
    297  . . D CLEAN^DILF ; CLEAN UP
    298  . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
    299  . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
    300  Q ZVARN
    301  ;
     281        ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
     282        ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
     283        ;
     284        N ZCCRD,ZVARN,C0CFDA2
     285        S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
     286        S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
     287        I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
     288        . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
     289        . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
     290        . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
     291        . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
     292        . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
     293        . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
     294        . I $D(ZERR) D  ; LAYGO ERROR
     295        . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
     296        . E  D  ;
     297        . . D CLEAN^DILF ; CLEAN UP
     298        . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
     299        . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
     300        Q ZVARN
     301        ;
    302302BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
    303  ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
    304  ;
    305  N C0CDIC,C0CNODE ;
    306  S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
    307  S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
    308  Q
    309  ;
     303        ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
     304        ;
     305        N C0CDIC,C0CNODE ;
     306        S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
     307        S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
     308        Q
     309        ;
    310310FIXSEC  ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
    311  ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
    312  ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
    313  ; CONVERSION
    314  ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
    315  D FIELDS^C0CRNF("C0CC",170)
    316  S C0CI=""
    317  F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
    318  . S C0CZX=""
    319  . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
    320  . . W "SECTION ",C0CI," VAR ",C0CZX
    321  . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
    322  . . W " TYPE: ",C0CV,!
    323  . . D SETFDA("SECTION",C0CV)
    324  . . ;ZWR C0CFDA
    325  Q
    326  ;
     311        ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
     312        ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
     313        ; CONVERSION
     314        ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
     315        D FIELDS^C0CRNF("C0CC",170)
     316        S C0CI=""
     317        F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
     318        . S C0CZX=""
     319        . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
     320        . . W "SECTION ",C0CI," VAR ",C0CZX
     321        . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
     322        . . W " TYPE: ",C0CV,!
     323        . . D SETFDA("SECTION",C0CV)
     324        . . ;ZWR C0CFDA
     325        Q
     326        ;
    327327SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
    328  ; TO SET TO VALUE C0CSV.
    329  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
    330  ; C0CSN,C0CSV ARE PASSED BY VALUE
    331  ;
    332  N C0CSI,C0CSJ
    333  S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
    334  S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
    335  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
    336  Q
     328        ; TO SET TO VALUE C0CSV.
     329        ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
     330        ; C0CSN,C0CSV ARE PASSED BY VALUE
     331        ;
     332        N C0CSI,C0CSJ
     333        S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
     334        S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
     335        S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
     336        Q
    337337ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
    338  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
    339  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    340  I '$D(ZTAB) S ZTAB="C0CA"
    341  N ZR
    342  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
    343  E  S ZR=""
    344  Q ZR
     338        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
     339        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     340        I '$D(ZTAB) S ZTAB="C0CA"
     341        N ZR
     342        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
     343        E  S ZR=""
     344        Q ZR
    345345ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
    346  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
    347  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    348  I '$D(ZTAB) S ZTAB="C0CA"
    349  N ZR
    350  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
    351  E  S ZR=""
    352  Q ZR
    353  ;
     346        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
     347        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     348        I '$D(ZTAB) S ZTAB="C0CA"
     349        N ZR
     350        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
     351        E  S ZR=""
     352        Q ZR
     353        ;
    354354ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
    355  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
    356  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    357  I '$D(ZTAB) S ZTAB="C0CA"
    358  N ZR
    359  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
    360  E  S ZR=""
    361  Q ZR
    362  ;
     355        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
     356        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     357        I '$D(ZTAB) S ZTAB="C0CA"
     358        N ZR
     359        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
     360        E  S ZR=""
     361        Q ZR
     362        ;
Note: See TracChangeset for help on using the changeset viewer.