Changeset 1544 for ccr/trunk/p/C0CFM1.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/C0CFM1.m

    r1336 r1544  
    1 C0CFM1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
    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  W !
    22  Q
    23  ;
    24 PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
    25  ;
    26  S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
    27  I '$D(ZWHICH) S ZWHICH="ALL"
    28  I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
    29  . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
    30  . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
    31  E  D  ; MULTIPLE SECTIONS
    32  . S C0CVARS=$NA(@C0CGLB)
    33  . S C0CI=""
    34  . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
    35  . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
    36  . . D PUTRIM1(DFN,C0CI,C0CVARSN)
    37  Q
    38  ;
    39 PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
    40  ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
    41  S C0CX=0
    42  F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
    43  . W "ZOCC=",C0CX,!
    44  . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
    45  . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
    46  Q
    47  ;
    48 PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
    49  ; ^C0C(171.201,   DFN IS THE PATIENT IEN PASSED BY VALUE
    50  ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
    51  ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
    52  ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
    53  ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
    54  ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
    55  ;
    56  S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
    57  ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
    58  N ZF,ZFV S ZF=171.201 S ZFV=171.2012
    59  S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
    60  N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
    61  N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
    62  W "ZTYPE: ",ZTYPE," ",ZTYPN,!
    63  N ZVARN ; IEN OF VARIABLE BEING PROCESSED
    64  ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
    65  S C0CFDA(ZF,"?+1,",.01)=DFN
    66  S C0CFDA(ZF,"?+1,",.02)=ZSRC
    67  S C0CFDA(ZF,"?+1,",.03)=ZTYPN
    68  S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
    69  K ZERR
    70  D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
    71  I $D(ZERR) B  ;OOPS
    72  K C0CFDA
    73  S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
    74  W "RECORD NUMBER: ",ZD0,!
    75  ;B
    76  S ZCNT=0
    77  S ZC0CI="" ;
    78  F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
    79  . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
    80  . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
    81  . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
    82  . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
    83  . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
    84  . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
    85  . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
    86  . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
    87  ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
    88  ;S GT1(170,"?+1,",12)="DIR"
    89  ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
    90  ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
    91  D CLEAN^DILF
    92  D UPDATE^DIE("","C0CFDA","","ZERR")
    93  Q
    94  ;
    95 VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
    96  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
    97  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
    98  ;
    99  N ZCCRD,ZVARN,C0CFDA2
    100  S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
    101  S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
    102  I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
    103  . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
    104  . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
    105  . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
    106  . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
    107  . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
    108  . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
    109  . I $D(ZERR) D  ; LAYGO ERROR
    110  . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
    111  . E  D  ;
    112  . . D CLEAN^DILF ; CLEAN UP
    113  . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
    114  . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
    115  Q ZVARN
    116  ;
    117 BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
    118  ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
    119  ;
    120  N C0CDIC,C0CNODE ;
    121  S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
    122  S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
    123  Q
    124  ;
    125 FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
    126  ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
    127  ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
    128  ; CONVERSION
    129  ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
    130  D FIELDS^C0CRNF("C0CC",170)
    131  S C0CI=""
    132  F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
    133  . S C0CZX=""
    134  . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
    135  . . W "SECTION ",C0CI," VAR ",C0CZX
    136  . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
    137  . . W " TYPE: ",C0CV,!
    138  . . D SETFDA("SECTION",C0CV)
    139  . . ;ZWR C0CFDA
    140  Q
    141  ;
    142 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
    143  ; TO SET TO VALUE C0CSV.
    144  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
    145  ; C0CSN,C0CSV ARE PASSED BY VALUE
    146  ;
    147  N C0CSI,C0CSJ
    148  S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
    149  S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
    150  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
    151  Q
    152 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
    153  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
    154  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    155  I '$D(ZTAB) S ZTAB="C0CA"
    156  N ZR
    157  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
    158  E  S ZR=""
    159  Q ZR
    160 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
    161  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
    162  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    163  I '$D(ZTAB) S ZTAB="C0CA"
    164  N ZR
    165  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
    166  E  S ZR=""
    167  Q ZR
    168  ;
    169 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
    170  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
    171  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    172  I '$D(ZTAB) S ZTAB="C0CA"
    173  N ZR
    174  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
    175  E  S ZR=""
    176  Q ZR
    177  ;
     1C0CFM1    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
     2        ;;1.2;C0C;;May 11, 2012;Build 47
     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        W !
     22        Q
     23        ;
     24PUTRIM(DFN,ZWHICH)      ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
     25        ;
     26        S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
     27        I '$D(ZWHICH) S ZWHICH="ALL"
     28        I ZWHICH'="ALL" D  ; SINGLE SECTION REQUESTED
     29        . S C0CVARS=$NA(@C0CGLB@(ZWHICH))
     30        . D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
     31        E  D  ; MULTIPLE SECTIONS
     32        . S C0CVARS=$NA(@C0CGLB)
     33        . S C0CI=""
     34        . F  S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI=""  D  ;FOR EACH SECTION
     35        . . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
     36        . . D PUTRIM1(DFN,C0CI,C0CVARSN)
     37        Q
     38        ;
     39PUTRIM1(DFN,ZZTYP,ZVARS)        ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
     40        ; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
     41        S C0CX=0
     42        F  S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX=""  D  ; FOR EACH OCCURANCE
     43        . W "ZOCC=",C0CX,!
     44        . S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
     45        . D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
     46        Q
     47        ;
     48PUTELS(DFN,ZTYPE,ZOCC,ZVALS)    ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
     49        ; ^C0C(171.201,   DFN IS THE PATIENT IEN PASSED BY VALUE
     50        ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
     51        ; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
     52        ; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
     53        ; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
     54        ; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
     55        ;
     56        S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
     57        ; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
     58        N ZF,ZFV S ZF=171.201 S ZFV=171.2012
     59        S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
     60        N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
     61        N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
     62        W "ZTYPE: ",ZTYPE," ",ZTYPN,!
     63        N ZVARN ; IEN OF VARIABLE BEING PROCESSED
     64        ;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
     65        S C0CFDA(ZF,"?+1,",.01)=DFN
     66        S C0CFDA(ZF,"?+1,",.02)=ZSRC
     67        S C0CFDA(ZF,"?+1,",.03)=ZTYPN
     68        S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
     69        K ZERR
     70        D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
     71        I $D(ZERR) B  ;OOPS
     72        K C0CFDA
     73        S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
     74        W "RECORD NUMBER: ",ZD0,!
     75        ;B
     76        S ZCNT=0
     77        S ZC0CI="" ;
     78        F  S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI=""  D  ;
     79        . I ZC0CI'="M" D  ; NOT A SUBVARIABLE
     80        . . S ZCNT=ZCNT+1 ;INCREMENT COUNT
     81        . . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
     82        . . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
     83        . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
     84        . . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
     85        . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
     86        . . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
     87        ;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
     88        ;S GT1(170,"?+1,",12)="DIR"
     89        ;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
     90        ;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
     91        D CLEAN^DILF
     92        D UPDATE^DIE("","C0CFDA","","ZERR")
     93        Q
     94        ;
     95VARPTR(ZVAR,ZTYP)       ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
     96        ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
     97        ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
     98        ;
     99        N ZCCRD,ZVARN,C0CFDA2
     100        S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
     101        S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
     102        I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
     103        . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
     104        . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
     105        . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
     106        . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
     107        . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
     108        . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
     109        . I $D(ZERR) D  ; LAYGO ERROR
     110        . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
     111        . E  D  ;
     112        . . D CLEAN^DILF ; CLEAN UP
     113        . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
     114        . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
     115        Q ZVARN
     116        ;
     117BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
     118        ; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
     119        ;
     120        N C0CDIC,C0CNODE ;
     121        S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
     122        S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
     123        Q
     124        ;
     125FIXSEC  ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
     126        ; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
     127        ; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
     128        ; CONVERSION
     129        ;N C0CC,C0CI,C0CJ,C0CN,C0CZX
     130        D FIELDS^C0CRNF("C0CC",170)
     131        S C0CI=""
     132        F  S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI=""  D  ; EACH SECTION
     133        . S C0CZX=""
     134        . F  S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX=""  D  ; EACH VARIABLE
     135        . . W "SECTION ",C0CI," VAR ",C0CZX
     136        . . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
     137        . . W " TYPE: ",C0CV,!
     138        . . D SETFDA("SECTION",C0CV)
     139        . . ;ZWR C0CFDA
     140        Q
     141        ;
     142SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
     143        ; TO SET TO VALUE C0CSV.
     144        ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
     145        ; C0CSN,C0CSV ARE PASSED BY VALUE
     146        ;
     147        N C0CSI,C0CSJ
     148        S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
     149        S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
     150        S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
     151        Q
     152ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
     153        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
     154        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     155        I '$D(ZTAB) S ZTAB="C0CA"
     156        N ZR
     157        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
     158        E  S ZR=""
     159        Q ZR
     160ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
     161        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
     162        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     163        I '$D(ZTAB) S ZTAB="C0CA"
     164        N ZR
     165        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
     166        E  S ZR=""
     167        Q ZR
     168        ;
     169ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
     170        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
     171        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     172        I '$D(ZTAB) S ZTAB="C0CA"
     173        N ZR
     174        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
     175        E  S ZR=""
     176        Q ZR
     177        ;
Note: See TracChangeset for help on using the changeset viewer.