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

    r1336 r1544  
    1 C0CRNF   ; CCDCCR/GPL - Reference Name Format (RNF) 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 Reference Name Format (RNF) Utility Library ",!
    21  W !
    22  Q
    23  ;
    24 FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
    25  ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
    26  ;
    27  N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
    28  N C0CFN ; FIELD NAME
    29  S C0CFI=0 S C0CFJ=C0CF
    30  K @C0CFRTN ; CLEAR THE RETURN ARRAY
    31  F  Q:C0CFJ'[C0CF  D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
    32  . ;W "1: "_C0CFJ," ",C0CFI,!
    33  . F  S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0  D  ; EVERY FIELD
    34  . . ;W "2: "_C0CFJ," ",C0CFI,!
    35  . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
    36  . . ;W "N: ",C0CFN,!
    37  . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
    38  . . I $D(@C0CFRTN@(C0CFN)) D  ; IS THIS A DUPLICATE?
    39  . . . I $G(DEBUG) D  ;
    40  . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
    41  . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
    42  . . E  S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
    43  . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
    44  Q
    45  ;
    46 TESTRNF ; TEST THE RNF1TO2 ROUTINE
    47  S G1("ONE")=1
    48  S G1("TWO")=2
    49  S G1("THREE")=3
    50  D RNF1TO2("GPL","G1")
    51  S G1("ONE")="NOT1"
    52  S G1("TWO")="STILL2"
    53  S G1("THREE")=3
    54  D RNF1TO2("GPL","G1")
    55  ZWR GPL
    56  Q
    57  ;
    58 RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
    59  ; (ZOUT) BOTH ARE PASSED BY NAME
    60  ; RNF1 IS OF THE FORM:
    61  ; @ZIN@("VAR1")=VAL1
    62  ; @ZIN@("VAR2")=VAL2
    63  ; RNF2 IS OF THE FORM:
    64  ; @ZOUT@("F","VAR1")=""
    65  ; @ZOUT@("F","VAR2")=""
    66  ; @ZOUT@("V",n,"VAR1")=VAL1
    67  ; @ZOUT@("V",n,"VAR2")=VAL2
    68  ; WHERE n IS THE "ROW" OF THE ARRAY
    69  N ZI S ZI=""
    70  N ZN
    71  I '$D(@ZOUT@("V",1)) S ZN=1
    72  E  S ZN=$O(@ZOUT@("V",""),-1)+1
    73  F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
    74  . S @ZOUT@("F",ZI)=""
    75  . S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
    76  Q
    77  ;
    78 RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
    79  ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
    80  ; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
    81  ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
    82  ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV
    83  ; WITH RNF2CSV
    84  ; (ZOUT) BOTH ARE PASSED BY NAME
    85  ; RNF1 IS OF THE FORM:
    86  ; @ZIN@("VAR1")=VAL1
    87  ; @ZIN@("VAR2")=VAL2
    88  ; RNF2 IS OF THE FORM:
    89  ; @ZOUT@("F","VAR1")=""
    90  ; @ZOUT@("F","VAR2")=""
    91  ; @ZOUT@("V",n,"VAR1",1)=VAL1
    92  ; @ZOUT@("V",n,"VAR2",1)=VAL2
    93  ; WHERE n IS THE "ROW" OF THE ARRAY
    94  N ZI S ZI=""
    95  N ZN
    96  I '$D(@ZOUT@("V",1)) S ZN=1
    97  E  S ZN=$O(@ZOUT@("V",""),-1)+1
    98  F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
    99  . S @ZOUT@("F",ZI)=""
    100  . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
    101  Q
    102  ;
    103 GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
    104  ; GRTN IS PASSED BY NAME
    105  ;
    106  N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
    107  I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
    108  E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
    109  S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
    110  D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
    111  D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
    112  D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
    113  S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
    114  S (C0CI,C0CJ)=""
    115  F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
    116  . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
    117  . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
    118  . . ;W C0CJ," ",C0CI,!
    119  . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
    120  . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
    121  . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
    122  . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
    123  I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
    124  . S C0CI=""
    125  . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
    126  . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
    127  Q
    128  ;
    129 GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
    130  ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
    131  ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
    132  ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
    133  ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
    134  ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
    135  ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
    136  ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
    137  ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
    138  ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
    139  ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
    140  ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
    141  ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
    142  ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
    143  ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
    144  ; GREF IS THE VALUE FOR THE INDEX
    145  ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
    146  ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
    147  ;
    148  ;
    149  N GIEN,GF
    150  S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
    151  I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
    152  E  D  ; WE ARE USING AN INDEX
    153  . ;N ZG
    154  . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
    155  . I ZG'="" D  ;
    156  . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
    157  . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
    158  . . E  S GIEN="" ; NOT FOUND IN INDEX
    159  . E  S GIEN="" ;
    160  ;W "IEN: ",GIEN,!
    161  ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
    162  I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
    163  E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
    164  S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
    165  D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
    166  K C0CTMP
    167  D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
    168  D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
    169  S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
    170  S (C0CI,C0CJ)=""
    171  F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
    172  . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
    173  . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
    174  . . ;W C0CJ," ",C0CI,!
    175  . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
    176  . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
    177  . . I C0CVALUE["C0CTMP" D  ; WP FIELD
    178  . . . N ZT,ZWP S ZWP=0 ;ITERATOR
    179  . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
    180  . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
    181  . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
    182  . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
    183  . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
    184  . . . . S C0CVALUE=C0CVALUE_ZT ;
    185  . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
    186  . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
    187  I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
    188  . S C0CI=""
    189  . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
    190  . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
    191  Q
    192  ;
    193 GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
    194  ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
    195  ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
    196  ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
    197  ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
    198  ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
    199  ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
    200  ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
    201  ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
    202  ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
    203  ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
    204  ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
    205  ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
    206  ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
    207  ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
    208  ; GREF IS THE VALUE FOR THE INDEX
    209  ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
    210  ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
    211  ;
    212  ;
    213  N GIEN,GF
    214  S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
    215  I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
    216  E  D  ; WE ARE USING AN INDEX
    217  . ;N ZG
    218  . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
    219  . I ZG'="" D  ;
    220  . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
    221  . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
    222  . . E  S GIEN="" ; NOT FOUND IN INDEX
    223  . E  S GIEN="" ;
    224  ;W "IEN: ",GIEN,!
    225  ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
    226  I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
    227  E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
    228  S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
    229  D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
    230  K C0CTMP
    231  D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
    232  D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
    233  S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
    234  S (C0CI,C0CJ)=""
    235  F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
    236  . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
    237  . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
    238  . . ;W C0CJ," ",C0CI,!
    239  . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
    240  . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
    241  . . I C0CVALUE["C0CTMP" D  ; WP FIELD
    242  . . . N ZT,ZWP S ZWP=0 ;ITERATOR
    243  . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
    244  . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
    245  . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
    246  . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
    247  . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
    248  . . . . S C0CVALUE=C0CVALUE_ZT ;
    249  . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
    250  . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
    251  I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
    252  . S C0CI=""
    253  . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
    254  . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
    255  Q
    256  ;
    257 GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
    258  ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
    259  ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
    260  ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
    261  ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
    262  ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
    263  ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
    264  ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
    265  ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
    266  ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
    267  ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
    268  ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
    269  ; .. OF THE FILE WILL BE USED
    270  ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
    271  ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
    272  ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
    273  ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
    274  ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
    275  ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
    276  ;N GATMP,GAI,GAF
    277  S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
    278  I '$D(GAIDX) S GAIDX="" ;DEFAULT
    279  I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
    280  I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
    281  W GAF,!
    282  W $O(@GAF@(0)) ;
    283  S GAI=0 ;ITERATOR
    284  F  S GAI=$O(@GAF@(GAI)) Q:GAI=""  D  ;
    285  . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
    286  . N GAX S GAX=0
    287  . F  S GAX=$O(GATMP(GAX)) Q:GAX=""  D  ;PULL OUT THE FIELDS
    288  . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
    289  Q
    290  ;
    291 ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
    292  ;
    293  S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
    294  S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
    295  Q
    296  ;
    297 RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
    298  ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
    299  ; RNSTY IS STYLE OF THE OUTPUT -
    300  ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
    301  ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
    302  ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
    303  N RNR,RNC ;ROW ROOT,COL ROOT
    304  N RNI,RNJ,RNX
    305  I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
    306  I RNSTY="NV" D NV(RNRTN,RNIN)  ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
    307  E  D VN(RNRTN,RNIN) ;
    308  Q
    309  ;
    310 NV(RNRTN,RNIN) ;
    311  S RNR=$NA(@RNIN@("F"))
    312  S RNC=$NA(@RNIN@("V"))
    313  ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
    314  S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
    315  S RNI=""
    316  F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
    317  . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
    318  S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
    319  D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
    320  S RNI=""
    321  F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
    322  . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
    323  . S RNJ=""
    324  . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
    325  . . I $D(@RNC@(RNJ,RNI,1)) D  ; THIS ROW HAS THIS COLUMN
    326  . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
    327  . . E  S RNX=RNX_"," ; NUL COLUMN
    328  . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
    329  . D PUSH^C0CXPATH(RNRTN,RNX)
    330  Q
    331  ;
    332 VN(RNRTN,RNIN) ;
    333  S RNR=$NA(@RNIN@("V"))
    334  S RNC=$NA(@RNIN@("F"))
    335  ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
    336  S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
    337  S RNI=""
    338  F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
    339  . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
    340  S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
    341  D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
    342  S RNI=""
    343  F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
    344  . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
    345  . S RNJ=""
    346  . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
    347  . . I $D(@RNR@(RNI,RNJ,1)) D  ; THIS ROW HAS THIS COLUMN
    348  . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
    349  . . . S RNV=$TR(RNV,",","")
    350  . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
    351  . . E  S RNX=RNX_"," ; NUL COLUMN
    352  . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
    353  . D PUSH^C0CXPATH(RNRTN,RNX)
    354  Q
    355  ;
    356 READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
    357  ;
    358  Q $$FTG^%ZISH(PATH,NAME,GLB,1)
    359  ;
    360 FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
    361  ;
    362  ;N G1,G2
    363  I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
    364  S G1=$NA(^TMP($J,"C0CCSV",1))
    365  S G2=$NA(^TMP($J,"C0CCSV",2))
    366  D GETN2(G1,FNUM) ; GET THE MATRIX
    367  D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
    368  K @G1
    369  D FILEOUT(G2,"FILE_"_FNUM_".csv")
    370  K @G2
    371  Q
    372  ;
    373 FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
    374  ;
    375  W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
    376  Q
    377  ;
    378 FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
    379  ;
    380  N C0CF
    381  S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
    382  S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
    383  I C0CF["()" S C0CF=$P(C0CF,"()",1)
    384  Q C0CF
    385  ;
    386 SKIP ;
    387  N TXT,DIERR
    388  S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
    389  I $D(DIERR) D CLEAN^DILF Q
    390  W "  report_text:",!  ;Progress Note Text
    391  N LN S LN=0
    392  F  S LN=$O(TXT(LN)) Q:'LN  D
    393  . W "    text"_LN_": "_TXT(LN),!
    394  . Q
    395  Q
    396  ;
    397 RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
    398  ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
    399  ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
    400  ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES
    401  D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
    402  N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
    403  D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
    404  F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
    405  . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
    406  . D PUSH^C0CXPATH(ZOUT,ZV)
    407  D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
    408  S ZI=""
    409  F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
    410  . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
    411  . D PUSH^C0CXPATH(ZOUT,ZN)
    412  . S ZJ=0 ;RESET TO DO IT AGAIN
    413  . F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
    414  . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
    415  . . D PUSH^C0CXPATH(ZOUT,ZV)
    416  . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
    417  D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
    418  Q
    419  ;
    420 RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
    421  ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
    422  ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
    423  ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
    424  D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
    425  N ZI,ZJ S ZI="" S ZJ=0
    426  D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
    427  F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
    428  . S ZV="<td>"_ZI_"</td>"
    429  . D PUSH^C0CXPATH(ZOUT,ZV) ; name
    430  D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
    431  S ZI="" ;RESET TO DO AGAIN
    432  F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH ROW OF VARIABLES
    433  . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
    434  . F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
    435  . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
    436  . . D PUSH^C0CXPATH(ZOUT,ZV) ; value
    437  . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
    438  D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
    439  Q
    440  ;
    441 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
    442  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
    443  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    444  I '$D(ZTAB) S ZTAB="C0CA"
    445  Q $P(@ZTAB@(ZFN),"^",1)
    446 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
    447  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
    448  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    449  I '$D(ZTAB) S ZTAB="C0CA"
    450  Q $P(@ZTAB@(ZFN),"^",2)
    451 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
    452  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
    453  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    454  I '$D(ZTAB) S ZTAB="C0CA"
    455  Q $P($G(@ZTAB@(ZFN)),"^",3)
    456  ;
    457 ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
    458  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
    459  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    460  I '$D(ZTAB) S ZTAB="C0CA"
    461  Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
    462  ;
     1C0CRNF    ; CCDCCR/GPL - Reference Name Format (RNF) 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 Reference Name Format (RNF) Utility Library ",!
     21        W !
     22        Q
     23        ;
     24FIELDS(C0CFRTN,C0CF)    ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
     25        ; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
     26        ;
     27        N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
     28        N C0CFN ; FIELD NAME
     29        S C0CFI=0 S C0CFJ=C0CF
     30        K @C0CFRTN ; CLEAR THE RETURN ARRAY
     31        F  Q:C0CFJ'[C0CF  D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
     32        . ;W "1: "_C0CFJ," ",C0CFI,!
     33        . F  S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0  D  ; EVERY FIELD
     34        . . ;W "2: "_C0CFJ," ",C0CFI,!
     35        . . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
     36        . . ;W "N: ",C0CFN,!
     37        . . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
     38        . . I $D(@C0CFRTN@(C0CFN)) D  ; IS THIS A DUPLICATE?
     39        . . . I $G(DEBUG) D  ;
     40        . . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
     41        . . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
     42        . . E  S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
     43        . S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
     44        Q
     45        ;
     46TESTRNF ; TEST THE RNF1TO2 ROUTINE
     47        S G1("ONE")=1
     48        S G1("TWO")=2
     49        S G1("THREE")=3
     50        D RNF1TO2("GPL","G1")
     51        S G1("ONE")="NOT1"
     52        S G1("TWO")="STILL2"
     53        S G1("THREE")=3
     54        D RNF1TO2("GPL","G1")
     55        ZWR GPL
     56        Q
     57        ;
     58RNF1TO2(ZOUT,ZIN)       ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
     59        ; (ZOUT) BOTH ARE PASSED BY NAME
     60        ; RNF1 IS OF THE FORM:
     61        ; @ZIN@("VAR1")=VAL1
     62        ; @ZIN@("VAR2")=VAL2
     63        ; RNF2 IS OF THE FORM:
     64        ; @ZOUT@("F","VAR1")=""
     65        ; @ZOUT@("F","VAR2")=""
     66        ; @ZOUT@("V",n,"VAR1")=VAL1
     67        ; @ZOUT@("V",n,"VAR2")=VAL2
     68        ; WHERE n IS THE "ROW" OF THE ARRAY
     69        N ZI S ZI=""
     70        N ZN
     71        I '$D(@ZOUT@("V",1)) S ZN=1
     72        E  S ZN=$O(@ZOUT@("V",""),-1)+1
     73        F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
     74        . S @ZOUT@("F",ZI)=""
     75        . S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
     76        Q
     77        ;
     78RNF1TO2B(ZOUT,ZIN)      ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
     79        ; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
     80        ; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
     81        ; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
     82        ; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV
     83        ; WITH RNF2CSV
     84        ; (ZOUT) BOTH ARE PASSED BY NAME
     85        ; RNF1 IS OF THE FORM:
     86        ; @ZIN@("VAR1")=VAL1
     87        ; @ZIN@("VAR2")=VAL2
     88        ; RNF2 IS OF THE FORM:
     89        ; @ZOUT@("F","VAR1")=""
     90        ; @ZOUT@("F","VAR2")=""
     91        ; @ZOUT@("V",n,"VAR1",1)=VAL1
     92        ; @ZOUT@("V",n,"VAR2",1)=VAL2
     93        ; WHERE n IS THE "ROW" OF THE ARRAY
     94        N ZI S ZI=""
     95        N ZN
     96        I '$D(@ZOUT@("V",1)) S ZN=1
     97        E  S ZN=$O(@ZOUT@("V",""),-1)+1
     98        F  S ZI=$O(@ZIN@(ZI)) Q:ZI=""  D  ;
     99        . S @ZOUT@("F",ZI)=""
     100        . S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
     101        Q
     102        ;
     103GETNOLD(GRTN,GFILE,GIEN,GNN)    ; GET FIELDS FOR ACCESS BY NAME
     104        ; GRTN IS PASSED BY NAME
     105        ;
     106        N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
     107        I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
     108        E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
     109        S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
     110        D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
     111        D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
     112        D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
     113        S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
     114        S (C0CI,C0CJ)=""
     115        F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
     116        . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
     117        . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
     118        . . ;W C0CJ," ",C0CI,!
     119        . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
     120        . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
     121        . . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
     122        . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
     123        I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
     124        . S C0CI=""
     125        . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
     126        . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
     127        Q
     128        ;
     129GETN(GRTN,GFILE,GREF,GNDX,GNN)  ; GET BY NAME ; RETURN A FIELD VALUE MAP
     130        ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
     131        ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
     132        ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
     133        ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
     134        ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
     135        ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
     136        ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
     137        ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
     138        ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
     139        ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
     140        ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
     141        ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
     142        ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
     143        ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
     144        ; GREF IS THE VALUE FOR THE INDEX
     145        ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
     146        ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
     147        ;
     148        ;
     149        N GIEN,GF
     150        S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
     151        I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
     152        E  D  ; WE ARE USING AN INDEX
     153        . ;N ZG
     154        . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
     155        . I ZG'="" D  ;
     156        . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
     157        . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
     158        . . E  S GIEN="" ; NOT FOUND IN INDEX
     159        . E  S GIEN="" ;
     160        ;W "IEN: ",GIEN,!
     161        ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
     162        I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
     163        E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
     164        S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
     165        D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
     166        K C0CTMP
     167        D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
     168        D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
     169        S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
     170        S (C0CI,C0CJ)=""
     171        F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
     172        . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
     173        . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
     174        . . ;W C0CJ," ",C0CI,!
     175        . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
     176        . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
     177        . . I C0CVALUE["C0CTMP" D  ; WP FIELD
     178        . . . N ZT,ZWP S ZWP=0 ;ITERATOR
     179        . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
     180        . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
     181        . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
     182        . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
     183        . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
     184        . . . . S C0CVALUE=C0CVALUE_ZT ;
     185        . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
     186        . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
     187        I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
     188        . S C0CI=""
     189        . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
     190        . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
     191        Q
     192        ;
     193GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
     194        ; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
     195        ; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
     196        ; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
     197        ; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
     198        ; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
     199        ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
     200        ; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
     201        ; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
     202        ; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
     203        ; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
     204        ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
     205        ; IF GREF IS "" THE FIRST RECORD IS OBTAINED
     206        ; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
     207        ; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
     208        ; GREF IS THE VALUE FOR THE INDEX
     209        ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
     210        ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
     211        ;
     212        ;
     213        N GIEN,GF
     214        S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
     215        I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
     216        E  D  ; WE ARE USING AN INDEX
     217        . ;N ZG
     218        . S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
     219        . I ZG'="" D  ;
     220        . . I $QS(ZG,3)=GREF D  ; IS GREF IN INDEX?
     221        . . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
     222        . . E  S GIEN="" ; NOT FOUND IN INDEX
     223        . E  S GIEN="" ;
     224        ;W "IEN: ",GIEN,!
     225        ;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
     226        I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
     227        E  S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
     228        S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
     229        D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
     230        K C0CTMP
     231        D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
     232        D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
     233        S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
     234        S (C0CI,C0CJ)=""
     235        F  S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ=""  D  ; FOR ALL SUBFILES
     236        . S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
     237        . F  S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI=""  D  ; ARRAY OF FIELDS
     238        . . ;W C0CJ," ",C0CI,!
     239        . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
     240        . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
     241        . . I C0CVALUE["C0CTMP" D  ; WP FIELD
     242        . . . N ZT,ZWP S ZWP=0 ;ITERATOR
     243        . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
     244        . . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
     245        . . . F  S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP  D  ;
     246        . . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
     247        . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
     248        . . . . S C0CVALUE=C0CVALUE_ZT ;
     249        . . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
     250        . . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
     251        I C0CNN D  ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
     252        . S C0CI=""
     253        . F  S C0CI=$O(@GRTN@(C0CI)) Q:C0CI=""  D  ; GO THROUGH THE WHOLE ARRAY
     254        . . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
     255        Q
     256        ;
     257GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN)     ; RETURN FIELD MAP AND VALUES
     258        ; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
     259        ; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
     260        ; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
     261        ; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
     262        ; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
     263        ; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
     264        ; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
     265        ; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
     266        ; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
     267        ; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
     268        ; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
     269        ; .. OF THE FILE WILL BE USED
     270        ; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
     271        ; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
     272        ; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
     273        ; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
     274        ; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
     275        ; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
     276        ;N GATMP,GAI,GAF
     277        S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
     278        I '$D(GAIDX) S GAIDX="" ;DEFAULT
     279        I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
     280        I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
     281        W GAF,!
     282        W $O(@GAF@(0)) ;
     283        S GAI=0 ;ITERATOR
     284        F  S GAI=$O(@GAF@(GAI)) Q:GAI=""  D  ;
     285        . D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
     286        . N GAX S GAX=0
     287        . F  S GAX=$O(GATMP(GAX)) Q:GAX=""  D  ;PULL OUT THE FIELDS
     288        . . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
     289        Q
     290        ;
     291ADDNV(GNV,GNVN,GNVF,GNVV)       ; CREATE AN ELEMENT OF THE MATRIX
     292        ;
     293        S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
     294        S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
     295        Q
     296        ;
     297RNF2CSV(RNRTN,RNIN,RNSTY)       ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
     298        ; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
     299        ; RNSTY IS STYLE OF THE OUTPUT -
     300        ; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
     301        ; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
     302        ; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
     303        N RNR,RNC ;ROW ROOT,COL ROOT
     304        N RNI,RNJ,RNX
     305        I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
     306        I RNSTY="NV" D NV(RNRTN,RNIN)  ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
     307        E  D VN(RNRTN,RNIN) ;
     308        Q
     309        ;
     310NV(RNRTN,RNIN)  ;
     311        S RNR=$NA(@RNIN@("F"))
     312        S RNC=$NA(@RNIN@("V"))
     313        ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
     314        S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
     315        S RNI=""
     316        F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
     317        . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
     318        S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
     319        D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
     320        S RNI=""
     321        F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
     322        . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
     323        . S RNJ=""
     324        . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
     325        . . I $D(@RNC@(RNJ,RNI,1)) D  ; THIS ROW HAS THIS COLUMN
     326        . . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
     327        . . E  S RNX=RNX_"," ; NUL COLUMN
     328        . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
     329        . D PUSH^C0CXPATH(RNRTN,RNX)
     330        Q
     331        ;
     332VN(RNRTN,RNIN)  ;
     333        S RNR=$NA(@RNIN@("V"))
     334        S RNC=$NA(@RNIN@("F"))
     335        ;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
     336        S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
     337        S RNI=""
     338        F  S RNI=$O(@RNC@(RNI)) Q:RNI=""  D  ; FOR EACH COLUMN
     339        . S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
     340        S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
     341        D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
     342        S RNI=""
     343        F  S RNI=$O(@RNR@(RNI)) Q:RNI=""  D  ; FOR EACH ROW
     344        . S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
     345        . S RNJ=""
     346        . F  S RNJ=$O(@RNC@(RNJ)) Q:RNJ=""  D  ; FOR EACH COL
     347        . . I $D(@RNR@(RNI,RNJ,1)) D  ; THIS ROW HAS THIS COLUMN
     348        . . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
     349        . . . S RNV=$TR(RNV,",","")
     350        . . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
     351        . . E  S RNX=RNX_"," ; NUL COLUMN
     352        . S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
     353        . D PUSH^C0CXPATH(RNRTN,RNX)
     354        Q
     355        ;
     356READCSV(PATH,NAME,GLB)  ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
     357        ;
     358        Q $$FTG^%ZISH(PATH,NAME,GLB,1)
     359        ;
     360FILE2CSV(FNUM,FVN)      ; WRITES OUT A FILEMAN FILE TO CSV
     361        ;
     362        ;N G1,G2
     363        I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
     364        S G1=$NA(^TMP($J,"C0CCSV",1))
     365        S G2=$NA(^TMP($J,"C0CCSV",2))
     366        D GETN2(G1,FNUM) ; GET THE MATRIX
     367        D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
     368        K @G1
     369        D FILEOUT(G2,"FILE_"_FNUM_".csv")
     370        K @G2
     371        Q
     372        ;
     373FILEOUT(FOARY,FONAM)    ; WRITE OUT A FILE
     374        ;
     375        W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
     376        Q
     377        ;
     378FILEREF(FNUM)   ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
     379        ;
     380        N C0CF
     381        S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
     382        S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
     383        I C0CF["()" S C0CF=$P(C0CF,"()",1)
     384        Q C0CF
     385        ;
     386SKIP    ;
     387        N TXT,DIERR
     388        S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
     389        I $D(DIERR) D CLEAN^DILF Q
     390        W "  report_text:",!  ;Progress Note Text
     391        N LN S LN=0
     392        F  S LN=$O(TXT(LN)) Q:'LN  D
     393        . W "    text"_LN_": "_TXT(LN),!
     394        . Q
     395        Q
     396        ;
     397RNF2HNV(ZOUT,ZIN)       ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
     398        ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
     399        ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
     400        ; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES
     401        D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
     402        N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
     403        D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
     404        F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
     405        . S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
     406        . D PUSH^C0CXPATH(ZOUT,ZV)
     407        D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
     408        S ZI=""
     409        F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
     410        . S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
     411        . D PUSH^C0CXPATH(ZOUT,ZN)
     412        . S ZJ=0 ;RESET TO DO IT AGAIN
     413        . F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH OCCURANCE
     414        . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
     415        . . D PUSH^C0CXPATH(ZOUT,ZV)
     416        . D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
     417        D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
     418        Q
     419        ;
     420RNF2HVN(ZOUT,ZIN)       ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
     421        ; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
     422        ; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
     423        ; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
     424        D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
     425        N ZI,ZJ S ZI="" S ZJ=0
     426        D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
     427        F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
     428        . S ZV="<td>"_ZI_"</td>"
     429        . D PUSH^C0CXPATH(ZOUT,ZV) ; name
     430        D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
     431        S ZI="" ;RESET TO DO AGAIN
     432        F  S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0  D  ; FOR EACH ROW OF VARIABLES
     433        . D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
     434        . F  S ZI=$O(@ZIN@("F",ZI)) Q:ZI=""  D  ; FOR EACH VARIABLE
     435        . . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
     436        . . D PUSH^C0CXPATH(ZOUT,ZV) ; value
     437        . D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
     438        D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
     439        Q
     440        ;
     441ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
     442        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
     443        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     444        I '$D(ZTAB) S ZTAB="C0CA"
     445        Q $P(@ZTAB@(ZFN),"^",1)
     446ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
     447        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
     448        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     449        I '$D(ZTAB) S ZTAB="C0CA"
     450        Q $P(@ZTAB@(ZFN),"^",2)
     451ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
     452        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
     453        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     454        I '$D(ZTAB) S ZTAB="C0CA"
     455        Q $P($G(@ZTAB@(ZFN)),"^",3)
     456        ;
     457ZVALUEI(ZFN,ZTAB)       ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
     458        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
     459        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     460        I '$D(ZTAB) S ZTAB="C0CA"
     461        Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
     462        ;
Note: See TracChangeset for help on using the changeset viewer.