48. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:33:46 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

48.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHGENXML.m Mon Nov 5 16:42:11 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHGENXML.m Fri Nov 9 01:18:34 2018 UTC

48.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 2666
Changed 1 2
Inserted 0 0
Removed 0 0

48.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

48.4 Active regular expressions

No regular expressions were active.

48.5 Comparison detail

  1   CHGENXML ; HAC/DLB; C LAIM DATA  EXTRACTION  IN .XML F ORMAT
  2    ;;1.0;;CH AMPVA SYST EM;JULY 4,  1990;Buil d 10
  3    ;EPMO TRA INING EFFO RT-Begin 1 /1/2017;;; ;;Build 1
  4    ; ATTEMPT ED TO USE  THE NATION AL TEAM NO DE EXTRACT ION, BUT I NCONSISTEN CIES
  5    ; (ESPECI ALLY RELAT ED TO NODE  ENTRY COU NT ENTRY)  CAUSED THE  CODE TO E XIT
  6    ; EARLY.  I CREATED  A FUNCTION  THAT USE  $O IN LIEW  OF THE NO DE ENTRY C OUNTS
  7    ; TO ENSU RE THAT AL L ENTRIES  WOULD BE E XTRACTED. 
  8    
  9    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  10    ; GENXML  USES THE P DI VALUE F ROM THE IN PUT SCREEN  AND MAKES  THE CALLS  TO
  11    ; THE BUF FER FILE E XTRACTION  FUNCTIONS,  WHICH IN  TURN CONTR OL THE DAT A TO
  12    ; BE WRIT TEN TO THE  XML FILE.
  13    ; EACH BU FFER FUNCT ION DETERM INES THE D ATA TO BE  OUTPUT FOR  THAT CLAI M BUFFER.
  14    ; EVERY A TTEMPT HAS  BEEN MADE  TO SIMPLI FY THE PRO CESS, UTIL IZING A
  15    ; COMMON  SET OF FUN CTIONS TO  PERFORM TH E DATA EXT RACTION AN D WRITING  OF 
  16    ; THE DAT A TO THE X ML FILE.
  17    ; THIS FU NCTION CUR RENTLY SUP PORTS THE  EXTRACTION  FOR THE C LAIM
  18    ; BUFFERS  (^CHMXCL- >^CHMXCLF) , THE IMAG E BUFFERS  (^CHMIMAGE , ^CHMIMG) ,
  19    ; THE PAY MENT AND W ORK BUFFER S (^CHMPAY , ^CHMPAYW ) AND THE  ^CHMEDI
  20    ; BUFFER.  IT ALSO C ONTAINS BO TH DOCUMEN TED AND UN DOCUMENTED  CROSS-
  21    ; REFEREN CES FOR CL AIM LOOKUP  AND DEBUG .
  22    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  23    ;
  24   GENXML(PDI ,USER)
  25    ; ID   TH E IDENTIFY ING PDI
  26    ; USER TH E USER REQ UESTING TH E XML FILE  (USED IN  DIRECTORY  PATH FOR X ML FILE)
  27    N STYPE,P CN,CLI,IDX STR,AI,BI, CI,EI,FI,P AYI,EDII,L N,VERBOSE
  28    N MNODE                                                                                                 ; MN ODE IS A P LACE TO ST ORE THE "M ULTIPLE" N ODE ADDRES S
  29    S (AI,BI, CI,EI,FI,P AYI,EDII)= 0
  30    S VERBOSE =1
  31    S X=220 X  ^%ZOSF("R M")                                                               ; SET THE  CACHE DISP LAY TO 220  CHARACTER S WIDE
  32    U 0 W:VER BOSE !,"CA LLING FORM AT: >D GEN XML^CHGENX ML(PDI,USE RNAME)"
  33    U 0 W:VER BOSE !,"EX AMPLE CALL : >D GENXM L^CHGENXML (201503091 040364,"" DNS     XXXXX"")"
  34    U 0 W:VER BOSE !,"TH IS APP EXT RACTS CLAI M INFORMAT ION TO AN  ""XML"" FI LE IN ORDE R TO"
  35    U 0 W:VER BOSE !,"MO VE THE INF ORMATION I NTO A NEW  SET OF NOD ES, OR MOV E TO ANOTH ER ENVIRON MENT."
  36    U 0 W:VER BOSE !,"TH E PDI IDEN TIFIES THE  CLAIM FOR  EXTRACTIO N, AND THE  USERID ID ENTIFIES"
  37    U 0 W:VER BOSE !,"TH E TARGET D IRECTORY F OR THE XML  FILE. THE  XML FILEN AME IS BAS ED ON THE"
  38    U 0 W:VER BOSE !,"PD I. EXAMPLE : IMG_2015 0309104036 4.XML"
  39    I '$D(PDI )  D  Q
  40    .U 0 W:VE RBOSE !,"Y OU MUST PR OVIDE THE  PDI"
  41    I $D(^CHM XCLE("PDI" ,PDI))  D                                                ; IF SUC CESSFUL IN  DETERMINI NG THE PDI , BEGIN CL AIM BUFFER  EXTRACTIO N
  42    .S PCN=0, PCN=$O(^CH MXCLE("PDI ",PDI,PCN) )
  43    .S CLI=0, CLI=$O(^CH MXCLE("PDI ",PDI,PCN, CLI))            ; IN DEX INTO ^ CHMXCL()
  44    .S IDXSTR =0,IDXSTR= $O(^CHMXCL E("PDI",PD I,PCN,CLI, IDXSTR))
  45    I 'IDXSTR  W !,"INVA LID INDEX  STRING." Q
  46    S AI=$P(I DXSTR,"*", 1)                                                                ; TRANSACT ION BUFFER  (^CHMXCLA ())
  47    S BI=$P(I DXSTR,"*", 2)                                                                ; PROVIDER  BUFFER (^ CHMXCLB())
  48    S CI=$P(I DXSTR,"*", 3)                                                                ; PATIENT  BUFFER (^C HMXCLC())
  49    S EI=$P(I DXSTR,"*", 4)                                                                ; CLAIM BU FFER (^CHM XCLE())
  50    S FI=0,FI =$O(^CHMXC LF("B",EI, FI))                                          ; LINE B UFFER (^CH MXCLF())
  51    U 0 W:VER BOSE !,"PD I ("_PDI_" ) TYPE IS  "_$$GETPDI TYP(PDI)
  52    U 0 W:VER BOSE !,?10 ,"RAW CLAI M BUFFER I NDEX VALUE (S)"
  53    S LN="-"  F XN=2:1:8 0 S LN=LN_ "-"                                           ; LINE S EPARATOR,  CREATE LIN E
  54    U 0 W:VER BOSE !,LN
  55    U 0 W:VER BOSE !,"FI LE BUFFER       CHMXC L(",CLI,?5 0,$S($D(^C HMXCL(CLI) )=0:"UNAVA ILABLE",1: "")
  56    U 0 W:VER BOSE !,"TR ANSACTION  BUF  CHMXC LA(",AI,?5 0,$S($D(^C HMXCLA(AI) )=0:"UNAVA ILABLE",1: "")
  57    U 0 W:VER BOSE !,"PR OVIDER BUF FER  CHMXC LB(",BI,?5 0,$S($D(^C HMXCLB(BI) )=0:"UNAVA ILABLE",1: "")
  58    U 0 W:VER BOSE !,"PA TIENT BUFF ER   CHMXC LC(",CI,?5 0,$S($D(^C HMXCLC(CI) )=0:"UNAVA ILABLE",1: "")
  59    U 0 W:VER BOSE !,"CL AIM BUFFER      CHMXC LE(",EI,?5 0,$S($D(^C HMXCLE(EI) )=0:"UNAVA ILABLE",1: "")
  60    I EI  D
  61    .S (FI,VE NI)=0
  62    .F CNT=1: 1  S FI=$O (^CHMXCLF( "B",EI,FI) ) Q:'FI  D
  63    ..S:CNT=1  FI2=FI,SV CDATE=$P(^ CHMXCLF(FI ,1),"^",11 )              ; SAVE  THE INDEX  VALUE
  64    ..U 0 W:V ERBOSE !," LINE BUFFE R(",CNT,")    CHMXCLF (",FI
  65    ..I $D(^C HMXCLF(FI) )=0 U 0 W: VERBOSE ?5 0,"UNAVAIL ABLE"
  66    .U 0 W:VE RBOSE !!," IMAGE BUFF ER",?40
  67    .I $D(^CH MIMAGE(PDI )) U 0 W:V ERBOSE "CH MIMAGE(",P DI                               ; DISPLAY  THE ^CHMIM AGE() INDE X (PDI)
  68    .E  U 0 W :VERBOSE " UNAVAILABL E"
  69    .I PAYI=0   D
  70    ..S PAYI= 0,PAYI=$O( ^CHMPAY("C ",PDI,PAYI ))                                          ; ^CHMPAY  "I" INDEX
  71    ..S:PAYI  PAYJ=0,PAY J=$O(^CHMP AY("C",PDI ,PAYI,PAYJ ))             ; ^CHM PAY "J" IN DEX
  72    .U 0 W:VE RBOSE !,"P AY BUFFER  ",?40
  73    .I +(PAYI ) U 0 W:VE RBOSE "CHM PAY(",PAYI                                             ; REPORT A VAILABLILI TY OF POIN TER TO ^CH MPAY()
  74    .E  U 0 W :VERBOSE " UNAVAILABL E (REQUIRE D FOR ""CO MPLETE"" C LAIMS)"
  75    .S:PAYI C LMTYPE=$$P AYI2TYP(PA YI)                                                            ;  RETRIEVE C LAIM TYPE  FROM ^CHMP AY "ZEMC"  XREF (EDI  ONLY)
  76    .U 0 W !, "PAY ""ZEM C"" XREF " ,?40
  77    .I CLMTYP E'="" D
  78    ..S CHTPI D=0,CHTPID =$O(^CHMPA Y(PAYI,"ZE MC",CHTPID ))             ; RETR IEVE THE T RADING PAR TNER ID VA LUE
  79    ..S CHIDH LD=0,CHIDH LD=$O(^CHM PAY(PAYI," ZEMC",CHTP ID,CHIDHLD ))
  80    ..U 0 W:V ERBOSE "^C HMPAY(",PA YI,",""ZEM C"",",CHTP ID,",",CHI DHLD,")= " ,^CHMPAY(P AYI,"ZEMC" ,CHTPID,CH IDHLD)
  81    .S:PAYI E DII=0,EDII =$O(^CHMED I("C",PAYI ,EDII))
  82    .U 0 W:VE RBOSE !,"8 35 BUFFER" ,?40,"CHME DI(",EDII
  83    .; CREATE  AN XML FO R THE ^CLA IM FILE
  84    .S APPNAM E="EDIBUFF ER"                                             ; USE  APPNAME AS  THE ROOT  ELEMENT OF  XML, AND  AS THE CSS  FILENAME
  85    .S DIRPAT H="CHAMPVA _USER:["_U SER_"]"
  86    .S IMGNAM =DIRPATH_" IMG_"_PDI_ ".XML"
  87    .S CSSNAM =DIRPATH_" _IMG_"_PDI _".CSS"
  88    .S DTDNAM =DIRPATH_" _IMG"_PDI_ ".DTD"
  89    .S IMGHDL =$$CRE8XML (IMGNAM,CS SNAM,DTDNA M,"CLM_MOV E",PDI)        ; CREA TE XML FIL E AND RETU RN THE "HA NDLE"
  90    .I IMGHDL =""  D  Q
  91    ..U 0 W:I MGHDL="" ! ,"UNABLE T O OPEN THE  ",IMGNAM, " FILE FOR  WRITING."
  92    .; READY  TO START P OPULATING  THE XML FI LE WITH BU FFER DATA
  93    .;D:CLI F ILEBUF(CLI ,IMGHDL)                                                                  ;  WRITE THE  ^CHMXCL()  FILE BUFFE R CONTENTS  TO XML
  94    .;D:AI TR XBUF(AI,IM GHDL)                                                                              ; WR ITE THE ^C HMXCLA() T RANSACTION  BUFFER TO  XML FILE
  95    .;D:BI PR OVBUF(BI,I MGHDL)                                                                             ; WR ITE THE ^C HMXCLB() P ROVIDER BU FFER TO XM L FILE
  96    .;D:CI PA TBUF(CI,IM GHDL)                                                                              ; WR ITE THE ^C HMXCLC() P ATIENT BUF FER TO XML  FILE
  97    .D:EI CLM BUF(EI,IMG HDL)                                                                               ; WR ITE THE ^C HMXCLE() C LAIM BUFFE R TO XML F ILE
  98    .;D:EI LI NEBUF(EI,I MGHDL)                                                                             ; WR ITE THE ^C HMXCLF() L INE BUFFER  TO XML FI LE
  99    .;D:PDI I MAGBUF(PDI ,IMGHDL)                                                                  ;  WRITE THE  ^CHMIMAGE( )IMAGE BUF FER TO XML  FILE
  100    .;D:PDI I MGBUF(PDI, IMGHDL)                                                                            ; WR ITE THE ^C HMIMG() BU FFER TO XM L FILE
  101    .;D:EDII  PAYBUF(EDI I,IMGHDL)                                                                 ;  WRITE THE  ^CHMPAY()  PAYMENT BU FFER TO XM L FILE
  102    .;D:PAYI  PAYWRK(PAY I,IMGHDL)                                                                 ;  WRITE THE  ^CHMPAYW()  "WORK" DA TA TO XML
  103    .;D:EDII  EDIBUF(EDI I,IMGHDL)                                                                 ;  WRITE THE  ^CHMEDI()  EDI BUFFER  TO XML FI LE
  104    .D CLOSEX ML(IMGNAM, IMGHDL,"CL M_MOVE")
  105    Q
  106    .S DTDHDL =$$CRE8DTD (DTDNAM)                                                                  ;  CREATE THE  "DTD FILE ", GET FIL E HANDLE
  107    .I (DTDHD L="") D  Q
  108    ..U 0 W ! ,"UNABLE T O OPEN ",D TDNAM
  109    .S CSSHDL =$$CRE8CSS (CSSNAM,"I MGBUFFER", .ELMNTLST, APPNAME)       ; CREA TE STYLE S HEET FILE,  GET FILE  HANDLE
  110    .D CLOSEC SS(CSSNAM, CSSHDL)                                                                            ; CL OSE THE ST YLE SHEET  DESCRIPTOR  FILE
  111    Q
  112    ;
  113    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  114    ; CRE8XML () FUNCTIO N OPENS TH E OUTPUT F ILE FOR WR ITING THE  BUFFER 
  115    ; INFORMA TION. THER E ARE SPEC IFIC HEADE RS CREATED  THAT SUPP ORT THE
  116    ; XML FOR MAT.
  117    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  118    ; XML FIL E CREATION  FUNCTIONS
  119    ; CSS FIL E FUNCTION S   (STYLE  SHEET FIL E)
  120    ; DTD FIL E FUNCTION S   (DOCUM ENT TYPE D ESCRIPTOR)
  121    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  122    ;
  123   CRE8XML(FN AME,CSSNAM ,DTDNAM,AP PNAME,UNIQ UEID)
  124    ; FNAME                  DIR PA TH /FILENA ME IS USED  FOR CREAT ING FILE
  125    ; CSSNAM        DIR  PATH / FIL ENAME OF T HE STYLE S HEET FOR T HIS XML FI LE
  126    ; DTDNAM        DIR  PATH / FIL ENAME FOR  DOCUMENT T YPE DESCRI PTOR
  127    ; APPNAME       DOC  TYPE AND S TYLE SHEET  IS NAMED  SAME 
  128    ; UNIQUEI D     FILE  NAMING; P DI USED FO R EDIBUFFE R
  129    N NAME,CN T,ROOTELM, YR
  130    S OPEN=$$ OPENFIWR^C HTFLIB9(.F NAME,FNAME )
  131    I OPEN  D  
  132    .D NOW^%D TC
  133    .S TS=X
  134    .S YR=$E( TS,1,3),YR =YR+1700
  135    .S TS=$$D TCVRT(YR_$ E(TS,4,7))
  136    .S ROOTEL M=$$LOWER^ CHTFLIB(AP PNAME)     ; CONVERTS  STRING TO  LOWER CAS
  137    .U FNAME  W "<?xml v ersion=""1 .0"" encod ing=""UTF- 8"" standa lone=""yes ""?>"
  138    .U FNAME  W !,"<Expo rt generat or=""Cache "" version =""25"" zv =""Cache f or OpenVMS /ALPHA V8. x (Alpha)  2011.1.2 ( Build 701) "" ts=""20 14-08-14 1 6:37:48""> "
  139    .U FNAME  W !,"<Rout ine name=" "CHGENXML" " type=""I NT"" langu agemode="" 0"" timest amp="""_TS _""">"
  140    .U FNAME  W !,"<!--G ENERATED F ILE: "_FNA ME_"-->"
  141    .U FNAME  W !,"<!--C LAIM ID "_ UNIQUEID_" -->"
  142    .U FNAME  W !,"<elem ent  name= ""CLAIM BU FFERS"" ty pe=""xs:st ring"">"
  143    E  S FNAM E=""
  144    Q FNAME
  145    ;
  146    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  147    ; CRE8DTD () CREATES  THE DTD ( DOCUMENT T YPE DESCRI PTOR) FILE
  148    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  149    ;
  150   CRE8DTD(FN AME)
  151    ; FNAME                  DIRECT ORY PATH A ND FILENAM E FOR THE  "CSS" FILE
  152    N OPEN
  153    S OPEN=$$ OPENFIWR^C HTFLIB9(.F NAME,"DTD" )
  154    Q:'OPEN " "
  155    Q FNAME
  156    ;
  157    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  158    ; CRE8CSS () CREATES  THE CSS S TYLE SHEET  FILE FOR  THE XML FI LE
  159    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  160    ;
  161   CRE8CSS(FN AME,APPNAM E,ELEMENTS ,ROOTELM)
  162    ; FNAME                  FILENA ME FOR THE  "CSS" FIL E
  163    ; APPNAME       APPL ICATION NA ME FOR THE  CSS FILE
  164    ; ELEMENT S     STRI NG ARRAY C ONTAINING  THE ELEMEN TS TO BE D ISPLAYED
  165    ; ROOTELM       ROOT  ELEMENT
  166    N NAME,RE TURN,CNT,O PEN
  167    S RETURN= ""
  168    S OPEN=$$ OPENFIWR^C HTFLIB9(.F NAME,FNAME )
  169    I OPEN  D
  170    .S RETURN =FNAME 
  171    .U FNAME  W !,"edi_b uffers {", !,?5,"back ground-col or: lights teelblue;" ,!,?5,"dis play: bloc k;",!,?5," padding: 1 0px;",!,?5 ,"font-fam ily: couri er new;",! ,"}"
  172    .U FNAME  W !,"eleme nt {",!,?5 ,"backgrou nd-color:  chartreuse ;",!,?5,"b order: 2px  solid bla ck;",!,?5, "font-weig ht: bold;" ,!,?5,"dis play: bloc k;",!,?5," margin-bot tom: 10px; ",!,"}"
  173    .U FNAME  W !,"eleme nt:before  {content:  ""ELEMENT:   ""}"
  174    .U FNAME  W !,"start  {",!,?5," font-weigh t: bold;", !,?5,"disp lay:block; ",!,"}"
  175    .U FNAME  W !,"field  {",!,?5," font-weigh t: bold;", !,?5,"disp lay: inlin e-block;", !,"width:  350px",!," }"
  176    .;U FNAME  W !,"fiel d:before { content: " "DATA FIEL D: ""}"
  177    .U FNAME  W !,"data  {",!,?5,"f ont-weight : bold;",! ,?5,"displ ay: inline ;",!,"}"
  178    .;U FNAME  W !,"data :before {c ontent: ""  VALUE:  " "}"
  179    .U FNAME  W !,"end { ",!,?5,"fo nt-weight:  bold;",!, ?5,"displa y:block;", !,"}"
  180    Q FNAME
  181    ;
  182    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  183    ; CLOSECS S() CLOSES  THE STYLE  SHEET FIL E CREATED  FOR THIS A PPLICATION
  184    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  185    ;
  186   CLOSECSS(F NAME,HANDL E)
  187    D CLOSEF^ CHTFLIB9(F NAME,HANDL E)
  188    Q
  189    ;
  190    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  191    ; CLOSEXM L() WRITES  THE "END"  FOR THE R OOT ELEMEN T AND CLOS ES THE FIL E
  192    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  193    ;
  194   CLOSEXML(F NAME,HANDL E,APPNAME)
  195    N ROOTELM
  196    S ROOTELM =$$LOWER^C HTFLIB(APP NAME)      ; CONVERTS  STRING TO  LOWER CAS E
  197    U FNAME W  !,"</elem ent>"                 ; CLOSE TH E ROOT ELE MENT GROUP  
  198    U FNAME W  !,"</Rout ine>"
  199    U FNAME W  !,"</Expo rt>"
  200    U 0 W !," CREATED HO ST XML FIL E: ",FNAME
  201    D CLOSEF^ CHTFLIB9(F NAME,HANDL E)
  202    Q
  203    ;
  204    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  205    ; START E LEMENT FUN CTION OUTP UTS THE RE QUIRED XML  FIELDS FO R THE STAR T
  206    ; OF EACH  ELEMENT F IELD
  207    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  208    ;
  209   STARTELE(G NAME,HANDL E)
  210    ; GNAME         THE  GLOBAL NAM E TO BE WR ITTEN
  211    ; HANDLE                 THE FI LE HANDLE  TO BE WRIT TEN
  212    N SIDX,EI DX,FNUMBER ,BUFNAME
  213    S SIDX=$L ($P(GNAME, "(",1))+2, EIDX=$L(GN AME)-1
  214    S BUFNAME =$P(GNAME, "(",1)
  215    S FNUMBER =$$GETFNUM (BUFNAME)                              ; US E THE PROV IDED GLOBA L NAME TO  GET FILE N UMBER
  216    U HANDLE  W !,?5,"<b uffer>"_BU FNAME_" FI LE #:"_FNU MBER_": FI LENAME:"_$ E(GNAME,1, (SIDX-1))_ ": IDX="_$ E(GNAME,SI DX,EIDX)_" </buffer>"
  217    U 0 W:VER BOSE !,?5, "DEBUG:  < buffer>"_B UFNAME_" F ILE #:"_FN UMBER_": F ILENAME:"_ $E(GNAME,1 ,(SIDX-1)) _": IDX:"_ $E(GNAME,S IDX,EIDX)_ ":</buffer >"
  218    Q
  219    ;
  220    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  221    ; END ELE MENT FUNCT ION OUTPUT S THE REQU IRED XML F IELDS FORT HE END OF  AN
  222    ; ELEMENT .
  223    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  224    ;
  225   ENDELE(GNA ME,HANDLE)
  226    ; GNAME         THE  GLOBAL NAM E TO BE WR ITTEN
  227    ; HANDLE                 THE FI LE HANDLE  TO BE WRIT TEN
  228    ;U HANDLE  W !,?15," <end></end >"
  229    U HANDLE  W !,?5,"</ element>"
  230    Q
  231    ;                                                                                                                          
  232    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  233    ; GLBLDMP () ACCEPTS  THE GLOBA L NAME OR  NODE THAT  THE USER W ANTS TO DI SPLAY
  234    ; OR WRIT TEN TO A F ILE. THE I NTENT AT T HE TIME OF  WRITING I S TO CREAT E AN
  235    ; XML FIL E THAT CON TAINS A CL AIM IN ITS  ENTIRETY.  THE RESUL TING XML F ILE
  236    ; COULD B E USED TO  MOVE THE C LAIM DATA  TO ANOTHER  ENVIRONME NT ("DEV"/ "TEST"/
  237    ; "PREPRO D"), OR PO TENTIALLY  FOR USE TO  "REOPEN"  A COMPLETE D CLAIM ON  THE
  238    ; PRODUCT ION SERVER .
  239    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  240    ; THE RES ULT IS THE  EXTRACTIO N AND PROC ESSING OF  ALL NODES  ASSOCIATED  WITH
  241    ; THE BAS E INDEX OF  THE GLOBA L DEFINED  BY "GNAME" . THIS IS  THE COMMON  ENTRY
  242    ; POINT F OR ALL OF  THE BUFFER  FILE EXTR ACTIONS.
  243    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  244    ;
  245   GLBLDMP(GN AME,TARGIO ,NAMLEN)
  246    ; GNAME         GLOB AL NAME TO  BE DUMPED  WITH THE  "I" INDEX
  247    ; TARGIO        IO H ANDLE FOR  OUTPUT
  248    ; NAMLEN        LENG TH OF NAME  FOR XML O UTPUT
  249    I $D(GNAM E)  D
  250    .D DUMPGL BL(GNAME,T ARGIO,NAML EN)                                                                     ; DI SPLAY/OUTP UT THE GLO BAL INFORM ATION
  251    Q
  252    ;
  253    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  254    ; DUMPGLB L(NODE,TIO )  USES TH E ^DD(FILE NUM,"GL")  CROSS-REFE RENCE TO R ETRIEVE
  255    ; THE FIE LD NAMES A ND TO GENE RATE THE N ODE ADDRES S TO RETRI EVE THE DA TA
  256    ; LEGEND  FOR RETURN  OF $DATA  CHECK:
  257    ; 0 = VAL UE TESTED  IS UNDEFIN ED
  258    ; 1 = VAL UE TESTED  IS DEFINED  AND CONTA INS DATA
  259    ; 10 = VA LUE TESTED  IS DEFINE D BUT IS O NLY A POIN TER TO SUB SCRIPTED E NTRY
  260    ; 11 = VA LUE TESTED  IS DEFINE D AND CONT AINS BOTH  DATA AND A  POINTER T O A SUBSCR IPTED ENTR Y
  261    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  262    ;
  263   DUMPGLBL(G NAME,TIO,N AMLEN)
  264    ;  GNAME                 GLOBAL  NAME AND  INDEX TO W RITE TO XM L FILE
  265    ;  TIO                   XML FI LE HANDLE
  266    ;  NAMLEN                LENGTH  OF THE GL OBAL NAME
  267    N FILENUM ,MFILENUM, INDX,REG,C NT,NODE,DN ODE,WNODE, NEWFNUM,NE WFNUM1,REG NUM,MSUB1, MSUB2,LSUB ,DDSUB,DDC NT,FSUB
  268    N MNAME,E XIT,QUIT,I EN,E0N,PRV FNUM,MULT, MLOOP
  269    S REGNUM= "",REG="", EON=0,PRVF NUM=""
  270    S NODE=GN AME
  271    S IEN=$$G ETIEN(NODE )                                                                         ;  GET THE IE N INDEX FR OM THE GLO BAL
  272    U 0 W:VER BOSE !,"DU MPGLBL:  N ODE ADDRES S = ",NODE
  273    I $P($P(N ODE,"(",2) ,",",1)?1A   D
  274    .I $D(@NO DE)  D
  275    ..D WRTXR EF(NODE,TI O)
  276    S FILENUM =$$GETFNUM (GNAME)                                                                   ;  GET THE BA SE FILE NU MBER BASED  ON THE FI LE NAME 
  277    F  S REGN UM=$O(^DD( FILENUM,"G L",REGNUM) )  Q:(REGN UM="")!(EO N)  D                 ; FOR EACH  INDEX, GE T EACH OF  THE FIELD  NUMBERS
  278    .S MULT=0
  279    .U 0 W:VE RBOSE !!," DUMPGLBL:   NEW ^DD A DDRESS= ^D D(",FILENU M,",""GL"" ,",REGNUM, ")"
  280    .S NEWFNU M=$$ISMULT (FILENUM,R EGNUM)                                        ; CHECK  THE ^DD(FI LENUM) NOD E TO SEE I F IT IS "M ULTIPLE" N ODE
  281    .I NEWFNU M  D                                                                                          ; YE S, IT IS A  "MULTIPLE " NODE DO  THIS CODE  BLOCK
  282    ..U 0 W:V ERBOSE "   ***YES***  MULTIPLE :   MFILENUM = ",NEWFNU M
  283    ..S MULT= MULT+1,MLO OP=1                                                                      ;  DO MULTIPL E LOOPS AS  LONG AS T HERE IS DA TA
  284    ..S MFILE NUM=NEWFNU M,EOMN=0,M NODE=NODE, MREG=""                   ; SET  UP THE NEW  FILE NUMB ER FOR THE  "MULTIPLE " NODE    
  285    ..F  Q:EO MN  S MREG =$O(^DD(MF ILENUM,"GL ",MREG)) Q :MREG=""   D            ; FOR EA CH INDEX,  GET EACH O F THE FIEL D NUMBERS
  286    ...U 0 W: VERBOSE !! ,"DUMPGLBL :  LOOP2:  MULTIPLE ^ DD ADDRESS = ^DD(",MF ILENUM,"," "GL"",",MR EG,")"
  287    ...S NEWF NUM1=$$ISM ULT(MFILEN UM,MREG)                                      ; CHECK  THE ^DD(FI LENUM) NOD E TO SEE I F IT IS "M ULTIPLE" N ODE
  288    ...S:NEWF NUM1 MFILE NUM=NEWFNU M1                                                     ; GET THE  NEW "MULTI PLE" FILE  NUMBER FOR  NEXT FIEL D/DATA RET RIEVAL
  289    ...S FIEL DS=$$GETFI ELDS(MFILE NUM,MREG,1 )                                  ; RETRIE VE THE FIE LDS FOR TH E CURRENT  FILE NUMBE R
  290    ...S DATA ="",MLOOP= 1                                                                         ;  INIT DATA  FOR NODE N OT POPULAT ED
  291    ...S REG= REGNUM                                                                                        ; SE T THE VALU E OF REG B ASED ON TH E MATCH/MI SMATCH OF  FILE NUMBE RS
  292    ...S:$L(M NODE,",")> 2 REG=MREG                                                        ; SET FOR  THE MREG V ALUE FOR ( I,70,1,X,0 )
  293    ...U 0 W: VERBOSE !, "DUMPGLBL:   LOOP2: M FILENUM: " ,MFILENUM, "  PRVFNUM = ",PRVFNU M,"  MREG=  ",MREG,"   REGNUM= " ,REGNUM,"   MLOOP= ", MLOOP
  294    ...S MNOD E=$$GETMNO DE(MNODE,R EG,MFILENU M,PRVFNUM, .MLOOP) ;  THE "MULTI PLE" DATA  NODE MNODE  + REG NUM BER
  295    ...S PRVF NUM=MFILEN UM,EXIT=0                                                         ; SAVE THE  WORKING F ILE NUMBER  FOR FUTUR E USE
  296    ...S EXIT =$$OUTPUTM (MNODE,TIO ,FIELDS,DA TA,.MLOOP)
  297    ...F IDX= 2:1  Q:EXI T  D
  298    ....S MNO DE=$$SETID X(MNODE,ID X)                                                     ; INCREMEN T THROUGH  THE "MULTI PLE" INDEX  COUNTS
  299    ....S EXI T=$$OUTPUT M(MNODE,TI O,FIELDS,D ATA,.MLOOP )
  300    ....I EXI T S MNODE= $$SETIDX(M NODE,1)
  301    .E  D                                                                                                            ; WE G ET HERE IF  NOT A "MU LTPLE" NOD E
  302    ..U 0 W:V ERBOSE "   *** NOT ** ** MULTIPL E"
  303    ..S FIELD S=$$GETFIE LDS(FILENU M,REGNUM,0 )                                  ; RETRIE VE THE FIE LDS FOR TH E CURRENT  FILE NUMBE R
  304    ..S DATA= ""                                                                                            ; IN IT DATA FO R NODE NOT  POPULATED
  305    ..S NODE= $$GETNODE( NODE,REGNU M)                                                     ; CREATE T HE DATA NO DE ADDRESS  FOR DATA  RETRIEVAL 
  306    ..U 0 W:V ERBOSE !," DUMPGLBL:  LOOP1 NODE = ",NODE 
  307    ..S EON=$ $ENDOFNODE (IEN,NODE)                                                        ; CHECK FO R END OF N ODE BASED  ON INDEX V ALUE
  308    ..Q:EON                                                                                                          ; EXIT  IF EON=TR UE
  309    ..S PRVFN UM=FILENUM                                                                           ;  SAVE THE F ILE NUMBER  FOR FUTUR E USE
  310    ..I ('$D( @NODE)!($D (@NODE)#10 '=1)) D                                       ; IF NOD E ISN'T DE FINED OR I F NOT POPU LATED WITH  DATA
  311    ...U 0 W  !,"DUMPGLB L: ",NODE, "  IS NOT  POPULATED"
  312    ...S DATA ="",EXIT=1                                                                           ;  WRITE THE  FIELDS WIT H BLANK DA TA
  313    ...Q:NODE ["B"  D                                                                                       ; DO  NOT WRITE  IF BLANK  XREF
  314    ...D WRIT EXML(NODE, TIO,FIELDS ,DATA)                                        ; WRITE  THE FIELD  NAMES AND  BLANK DATA  TO THE XM L FILE
  315    ..E  D                                                                                                           ; ELSE  IF NODE C ONTAINS DA TA
  316    ...S DATA =@NODE                                                                                        ; RE TRIEVE THE  DATA VALU ES
  317    ...D WRIT EXML(NODE, TIO,FIELDS ,DATA)                                        ; WRITE  THE FIELD  NAMES AND  DATA TO TH E XML FILE
  318    Q
  319    ;
  320    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  321    ; OUTPUTM (MNODE,TIO ,FIELDS,DA TA)  DETER MINES IF N ODE HAS DA TA, AND EI THER OUTPU TS 
  322    ; THE DAT A, OR OUTP UTS THE FI ELDS AND N ULL DATA
  323    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  324    ;
  325   OUTPUTM(MN ODE,TIO,FI ELDS,DATA, MLOOP)
  326    ; MNODE                  THE NO DE ADDRESS  TO OUTPUT
  327    ; TIO                    THE TA RGET IO FI LE
  328    ; FIELDS                 THE FI ELD NAMES  FOR THE NO DE(S)
  329    ; DATA                   THE DA TA TO BE W RITTEN
  330    ; MLOOP                  LOOP C OUNTER TO  BLOCK REDU NDANT OUTP UT
  331    N DVAL,EX IT
  332    S EXIT=0
  333    S DVAL=$D (@MNODE)                                                                             ;  IS CNODE P OINTER, DA TA OR BOTH  ?
  334    U 0 W:VER BOSE !,?10 ,"OUTPUTM:   MNODE= " ,MNODE,"   $D(@MNODE) = ",DVAL,"   MLOOP= " ,MLOOP
  335    I DVAL#10 '=1  D                                                                               ;  IF NODE CO NTAINS NO  DATA
  336    .U 0 W:VE RBOSE !,?1 0,"OUTPUTM :  ",MNODE ," CONTAIN S NO DATA"
  337    .S DATA=" "                                                                                             ; EX IT THE LOO P TO GET N EXT NODE F ROM ^DD()  (EOMN: END  OF MULTIP LE NODE)
  338    .I MLOOP= 1 D 
  339    ..D WRITE XML(MNODE, TIO,FIELDS ,DATA)                      ; WR ITE THE FI ELD NAMES  AND BLANK  DATA TO TH E XML FILE
  340    .S EXIT=1
  341    E  D                                                                                                    ; EL SE THE NOD E CONTAINS  POINTER O R USER DAT A
  342    .S DATA=@ MNODE                                                                                ;  GET THE DA TA FROM TH E GLOBAL N ODE
  343    .D WRITEX ML(MNODE,T IO,FIELDS, DATA)                                         ; ELSE W RITE THE F IELD NAMES  AND DATA  TO THE XML  FILE
  344    .S MLOOP= MLOOP+1
  345    Q EXIT
  346    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  347    ; SETIDX( NODE,IDX)  RESETS THE  MOST RECE NT VARIABL E INDES (J ,K,L) TO 1
  348    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  349    ;
  350   SETIDX(NOD E,IDX)
  351    ; NODE          THE  MULTIPLE N ODE TO BE  RESET
  352    N LSTSUB, SUBLEN,WNO DE
  353    S WNODE=N ODE
  354    S FLDCNT= $L(WNODE," ,")
  355    S $P(WNOD E,",",FLDC NT-1)=IDX
  356    Q WNODE
  357    ;
  358    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  359    ; SETCONS T(WNODE,VA L)  SETS T HE LAST CO NSTANT IN  THE NODE T O "VAL"
  360    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  361    ;
  362   SETCONST(N ODE,NUM,VA L)
  363    ; WNODE                           THE WORK ING NODE T O BE CHANG ED
  364    ; NUM                             THE VALU E NUMBER T O REPLACE
  365    ; VAL                             THE VALU E TO BE WR ITTEN INTO  THE NODE
  366    N WNODE,F LDCNT
  367    S WNODE=N ODE
  368    S FLDCNT= $L(WNODE," ,")                                    ; GE T THE NUMB ER OF FIEL DS IN THE  NODE
  369    S $P(WNOD E,",",NUM) =VAL                                   ; SE T THE VALU E INTO THE  NODE
  370    I (NUM=FL DCNT)&($E( $L(WNODE)- 1,$L(WNODE )-1)'=")")   D
  371    .S WNODE= WNODE_")"
  372    Q WNODE
  373    ;
  374    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  375    ; GETFNUM () RETURNS  THE FILE  NUMBER FOR  THE PROVI DED FILE N AME
  376    ; ANY COM BINATION O F THE NODE  IS VIABLE  SO LONG A S IT HAS T HE BUFFER
  377    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  378    ;
  379   GETFNUM(NO DE)
  380    ; NODE          THE  CURRENT WO RKING BUFF ER NAME (I .E ^CHMXCL F(812345,0 ) OR ^CHMX CLF(812345
  381    N FNUMARR ,FNUM
  382    S FNUMARR ("^CHMXCL" )="741210. 04^CLAIM F ILE"                                        ; SET UP A N ARRAY OF  FILE NUMB ERS FOR CL AIM BUFFER S
  383    S FNUMARR ("^CHMXCLA ")="741210 .06^TRANSA CTION"
  384    S FNUMARR ("^CHMXCLB ")="741210 .08^PROVID ER"
  385    S FNUMARR ("^CHMXCLC ")="741210 .1^PATIENT "
  386    S FNUMARR ("^CHMXCLE ")="741210 .12^CLAIM"
  387    S FNUMARR ("^CHMXCLF ")="741210 .14^SERVIC E LINE"
  388    S FNUMARR ("^CHMIMAG E")="74100 0.1^IMAGE"
  389    S FNUMARR ("^CHMIMG" )="741000. 2^IMAGE"
  390    S FNUMARR ("^CHMPAY" )="741000^ PAYMENT"
  391    S FNUMARR ("^CHMPAYW ")="741002 .602^WORK  FLOW"
  392    S FNUMARR ("^CHMEDI" )="741207. 01^835 STA TUS" 
  393    S FNUM=$P (FNUMARR($ P(NODE,"(" ,1)),"^",1 )                                                   ;  EXTRACT TH E FILE NAM E FROM THE  NODE INFO RMATION
  394    Q FNUM
  395    ;
  396    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  397    ; GETLSTS UB(NODE) E XTRACTS TH E LAST SUB SCRIPT FRO M THE PROV IDED NODE
  398    ; THIS WI LL BE USED  IN THE GE TFIELDS()  FUNCTION
  399    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  400    ;
  401   GETLSTSUB( GNODE)
  402    ;  GNODE                          THE WORK ING GLOBAL  NODE
  403    N SUBNUM, SUB
  404    S SUBNUM= $L(GNODE," ,")                                                                                         ; GET  THE NUMBER  OF SUBSCR IPTS
  405    S SUB=$P( GNODE,",", SUBNUM)                                                                                     ; GET  THE LAST S UBSCRIPT
  406    S SUB=$P( SUB,")",1)                                                                                             ; REMO VE THE FOL LOWING ")"
  407    Q SUB
  408    ;
  409    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  410    ; ISMULT( ) IS A BOO LEAN FUNCT ION THAT R ETURNS "FA LSE (0)" I F THE PROV IDED NODE 
  411    ; IS NOT  A  "MULTIP LE" NODE,  AND TRUE(N ON-ZERO) I F THE NODE  IS A "MUL TIPLE".
  412    ; *** THE  ^DD(FILEN UM,"GL") C ROSS-REFER ENCE CONTA INS A "0"  IN THE 4TH  POSITION
  413    ; IF THE  NODE IS A  "MULTIPLE"  NODE.
  414    ; *** THE RE IS ANOT HER CROSS- REFERENCE  FOR "MULTI PLE" NODES ; THE
  415    ; ^DD(FIL ENUM,"SB", FILENUM_ID X,IDX) CRO SS-REFEREN CE
  416    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  417    ;
  418   ISMULT(FIL ENUM,IDX)
  419    ; NODE          THE  NODE TO BE  TESTED
  420    N DDVAL,M ULT,SBREF, RETURN,SBI DX,MFILE,M FILENUM
  421    S RETURN= 0                                                                                                                        ; DEFAULT  TO NON-MUL TIPLE RETU RN
  422    S DDVAL=" ^DD("_FILE NUM_",""GL "","_IDX_" ,"_0_")"                                    ; BUILD TH E "GL" CRO SS-REFEREN CE NODE FO R MULTIPLE  CHECK
  423    U 0 W:VER BOSE !,?15 ,"ISMULT:   DDVAL= ", DDVAL
  424    S MULT=$D (@DDVAL)                                                                                                        ; FIRST  CHECK FOR  NODE IS A  "MULTIPLE"
  425    ;U 0 W:VE RBOSE !,?1 5,"ISMULT:   $D(DDVAL )= ",MULT
  426    I MULT=10   D
  427    .S MFILE= "^DD("_FIL ENUM_",IDX ,"_0_")"
  428    .I $D(@MF ILE)  D                                                                                                         ; TEST B EFORE ATTE MPTING TO  RETRIEVE T HE "MULTIP LE"FILE NU MBER
  429    ..;U 0 W: VERBOSE !, ?15,"ISMUL T:  $D(MFI LE)= ",$D( MFILE)
  430    .S MFILEN UM=$P((@MF ILE),"^",2 )                                                                       ; GE T THE "MUL TIPLE" FIL ENUMBER
  431    .S:MFILEN UM RETURN= MFILENUM
  432    .;U 0 W:V ERBOSE !,? 5,"ISMULT:   MFILE= " ,MFILE,"   MULT CHECK  #2= ",RET URN
  433    Q RETURN
  434    ;
  435    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  436    ; GETNODE (NODE,REG)  RETURNS T HE NODE AD DRESS FOR  NON-MULTIP LE NODES
  437    ; NOTE: T HIS FUNCTI ON RETURNS  THE NODE  ADDRESS EV EN IF IT I S NOT POPU LATED
  438    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  439    ;
  440   GETNODE(NO DE,REG)
  441    ; NODE          THE  NON-MULTIP LE NODE 
  442    ; REG           THE  REGISTER N UMBER FOR  THE CURREN T NODE
  443    N WNODE,S UBLEN,LSTS UB
  444    U 0 W:VER BOSE !,?10 ,"GETNODE:   INPUT= " ,NODE
  445    S LSTSUB= $$GETLSTSU B(NODE)
  446    S SUBLEN= $L(LSTSUB)
  447    S WNODE=N ODE,RTN=0                                                                                              ; GET  THE "MULTI PLE" NODE  INOT THE W ORKING VAR IABLE
  448    S WNODE=( $E(NODE,1, $L(NODE)-( SUBLEN+1)) )                                           ; REMOVE T HE LAST SU BSCRIPT AN D CLOSING  PAREN
  449    S WNODE=W NODE_REG_" )"                                                                                 ; SE T THE REGI STER INTO  THE NODE A DDRESS
  450    U 0 W !,? 10,"GETNOD E:  RETURN = ",WNODE
  451    Q WNODE
  452    ;
  453    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  454    ; GETMNOD E() RETURN S THE DATA  NODE ADDR ESS FOR TH E "MULTIPL E" NODE RE TRIEVED
  455    ; FROM TH E ^DD(FILE NUM) DATA  DICTIONARY .
  456    ; THIS FU NCTION WIL L WORK IND EPENDENTLY  OF THE AC TUAL "MULT IPLE" INDE X TO
  457    ; RETRIEV E. THIS IS  BECAUSE T HE INCOMIN G NODE DES CRIPTION W ILL CONTAI N THE 
  458    ; STARTIN G POINT FO R THE NODE  BEING WOR KED.
  459    ; I.E NOD E="^CHMXCL F(IEN,5)",  WILL RETU RN "^CHMXC LF(IEN,5,J ,0)"
  460    ;                        "^CHMX CLF(IEN,70 ,J,101) WI LL RETURN  ^CHMXCLF(I EN,70,J,10 1,K,0)
  461    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  462    ;
  463   GETMNODE(N ODE,REG,FN UM,PRVFNUM ,MLOOP)
  464    ; NODE                   THE MU LTIPLE NOD E (CONTAIN S THE IEN  AND POTENT IALLY OTHE R INDEXES)
  465    ; REG                    THE RE GISTER VAL UE FOR CRE ATING THE  NODE ADDRE SS
  466    ; FNUM                   CURREN T NODE FIL E NUMBER
  467    ; PRVFNUM                THE PR EVIOUS NOD E FILE NUM BER
  468    ; MLOOP                  EACH S UCCESSIVE  "MULTIPLE"  ADDS A VA RIABLE IND EX TO THE  NODE ADDRE SS (J,K,L, M)
  469    N WNODE,T NODE,CNT,I DX,FLDCNT, NUM
  470    U 0 W !,? 10,"GETMNO DE:  IN:   NODE= ",NO DE,"  REG=  ",REG,"   FNUM= ",FN UM,"  PREV  FNUM= ",P RVFNUM,"   MLOOP= ",M LOOP
  471    S WNODE=N ODE                                                                                                    ; GET  THE "MULTI PLE" NODE  INTO THE W ORKING VAR IABLE
  472    I FNUM=PR VFNUM  D       
  473    .U 0 W:VE RBOSE !,"F ILE NUMBER S MATCH!"                                              ; FILE NUM BERS CHANG ED, SO NOD E ADDRESSI NG CHANGES
  474    .I FNUM[7 41210.14   D
  475    ..S IDX=$ O(@WNODE)
  476    ..S FLDCN T=$L(WNODE ,",")
  477    ..S WNODE =$$SETCONS T(WNODE,FL DCNT,IDX)                                              ; REPLACE  THE LAST C ONSTANT WI TH "IDX"
  478    .E  I FNU M=741210.1 27  D
  479    ..U 0 W:V ERBOSE !,? 10,"^CHMXC LE() NODE  RETRIEVE:  IN= ",WNOD E
  480    ..S FLDCN T=$L(WNODE ,",")                                                                              ; GE T THE NUMB ER OF FIEL DS IN THE  NODE
  481    ..S WNODE =$$SETCONS T(WNODE,FL DCNT,REG)                                              ; REPLACE  THE LAST S UBSCRIPT 
  482    ..U 0 W:V ERBOSE !,? 10,"^CHMXC LE() NODE  RETRIEVE:  OUT= ",WNO DE
  483    E  D
  484    .U 0 W:VE RBOSE !,"F ILE NUMBER S CHANGED! "                                           ; FILE NUM BERS SAME,  GET NEXT  NODE
  485    .I $L(WNO DE,",")>2   D
  486    ..S WNODE =$$SETCONS T(WNODE,4, REG)
  487    .E  S WNO DE=$$SETCO NST(WNODE, 2,REG)
  488    .I $D(@WN ODE)  D                                                                                                ; IF ( I,X) IS A  VALID NODE
  489    ..S WNODE =$E(WNODE, 1,$L(WNODE )-1)                                                           ;  REMOVE THE  CLOSING P AREN                                                                                      
  490    ..S IDX=0
  491    ..S WNODE =WNODE_"," _IDX_")"                                                                  ;  THE "J","K ",OR "L" I NDEX SHOUL D NEVER BE  "0"
  492    ..S IDX=$ O(@WNODE)
  493    ..S:'IDX  IDX=1
  494    ..S LSTSU B=$$GETLST SUB(NODE)
  495    ..S SUBLE N=$L(LSTSU B)
  496    ..S WNODE =($E(WNODE ,1,$L(WNOD E)-(SUBLEN +1)))                              ; REMOVE  THE LAST  SUBSCRIPT  AND CLOSIN G PAREN
  497    ..S WNODE =WNODE_"," _IDX_",0)"
  498    .E  D
  499    ..S WNODE =$E(WNODE, 1,$L(WNODE )-1)                                                           ;  REMOVE THE  CLOSING P AREN
  500    ..S WNODE =WNODE_",1 ,0)"
  501    .U 0 W:VE RBOSE !,?1 0,"GETMNOD E:  RETURN   WNODE= " ,WNODE                  ; IF NOD E NOT POPU LATED, RET URN THE PR OVIDED NOD E
  502    Q WNODE
  503    ;
  504    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  505    ; GETNXTI DX(NODE,RE G) PERFORM S THE GATH ERING OF T HE NEXT VA RIABLE IND EX FOR
  506    ; A NODE.
  507    ; EXAMPLE : THE PREV IOUS NODE  (^CHMXCLF( I,70,J,.5)  = FILE NU MBER 74121 0.147 
  508    ; NEXT AD DRESS HAS  THE CONSTA NT VALUE " 101" AS TH E REGISTER  VALUE.
  509    ; THE $D( ^CHMXCLF(I ,70,1,101) ) AND HAS  FILE NUMBE R 741210.1 47101
  510    ; IN ORDE R TO GET T O THE NEXT  NODE ADDR ESS, YOU N EED TO GET  THE 
  511    ; NEXT VA RIABLE IND EX FOR THE  MULTIPLE  (I,70,J,10 1,K,0)
  512    ; THIS FU NCTION DOE S THAT FOR  YOU
  513    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  514    ;
  515   GETNXTIDX( NODE,REG)
  516    ; NODE          THE  CURRENT NO DE ADDRESS
  517    ; REG           THE  REGISTER V ALUE FOR G ENERATING  THE NEXT N ODE ADDRES S
  518    U 0 W !,? 5,"GETNXTI DX:  NODE=  ",NODE,"   REG= ",RE G
  519    N WNODE,T NODE,IDX
  520    S WNODE=N ODE                                                                                                    ; GET  THE "MULTI PLE" NODE  INOT THE W ORKING VAR IABLE
  521    S WNODE=( $E(NODE,1, $L(NODE)-1 ))                                                             ;  REMOVE THE  CLOSING P AREN
  522    S TNODE=W NODE                                                                                                   ; KEEP  A COPY OF  THE TRUNC ATED NODE  ADDRESS
  523    U 0 W:VER BOSE !,?5, "GETNXTIDX :  TNODE=  ",TNODE 
  524    S WNODE=W NODE_","_R EG_")"                                                                             ; SE T UP WNODE  FOR $O(WN ODE)
  525    U 0 W:VER BOSE !,?5, "GETNXTIDX :  SETUP W NODE= ",WN ODE                                                                                                    
  526    S IDX=0                                                                                                                   ; THE "J ","K",OR " L" INDEX S HOULD NEVE R BE "0"
  527    S IDX=$O( @WNODE)
  528    S:'IDX ID X=1
  529    U 0 W:VER BOSE !,?5, "GETNXTIDX :  IDX= ", IDX     
  530    S WNODE=T NODE_","_I DX_",0)"                                                                  ;  BUILD THE  NODE ADDRE SS FOR THE  DATA NODE
  531    U 0 W !,? 5,"GETMNOD E:  RETURN = ",WNODE                                              ; IF NODE  NOT POPULA TED, RETUR N THE PROV IDED NODE
  532    Q WNODE
  533    ;
  534    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  535    ; THIS FU NCTION RET URNS THE S UBNODE TO  THE PREVIO US DATA NO DE
  536    ; I.E. ^C HMXCLF(IEN ,70,1,0) S UBNODE ^CH MXCLF(IEN, 70,1,.5)
  537    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  538    ;
  539   GETMNODE1( NODE,REG)
  540    ; NODE          THE  MULTIPLE N ODE (CONTA INS THE IE N AND POTE NTIALLY OT HER INDEXE S)
  541    N WNODE,T NODE,CNT,I DX,LEN
  542    U 0 W !,? 5,"GETMNOD E1:  NODE=  ",NODE
  543    S LEN=$L( $$GETLSTSU B(NODE))
  544    S TNODE=$ E(NODE,1,$ L(NODE)-(L EN+1))                                                         ;  GET THE "M ULTIPLE" N ODE INTO T HE WORKING  VARIABLE
  545    U 0 W !,? 5,"GETMNOD E1:  TNODE = ",TNODE
  546    S WNODE=N ODE
  547    U 0 W !,? 5,"GETMNOD E1:  SETUP = ",WNODE
  548    S IDX=$O( @WNODE)
  549    S WNODE=T NODE_IDX_" )"                                                                                          ; BUIL D THE NODE  ADDRESS F OR THE DAT A NODE
  550    U 0 W !,? 5,"GETMNOD E1:  SETUP = ",WNODE
  551    I '$D(@WN ODE)  D
  552    .U 0 W !, ?5,"GETMNO DE1:  ",WN ODE,"  IS  NOT POPULA TED"
  553    U 0 W !,? 5,"GETMNOD E1:  RETUR N= ",WNODE                                                     ;  IF NODE NO T POPULATE D, RETURN  THE PROVID ED NODE
  554    Q WNODE
  555    ;
  556    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  557    ; GETSUB  MATCHES TH E VALUES P ROVIDED TO  THE ^DD(F ILENUM,"GL ",REG,CNT, SUBVAL)
  558    ; CROSS-R EFERENCE
  559    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  560    ;
  561   GETSUB(FIL ENUM,REG,S UBVAL)
  562    ;  FILENU M              THE FI LE NUMBER  FOR ^DD(FI LENUM,"GL" ,REG,CNT,S UBVAL)
  563    ;  REG                   THE RE GISTER VAL UE FOR ^DD (FILENUM," GL",REG,CN T,SUBVAL)
  564    ;  SUBVAL                THE ^D D(FILENUM, "GL",REG,C NT,SUBVAL)
  565    N EXIT,RS UB,CNT,RTN
  566    S EXIT=0, RTN=0
  567    F CNT=1:1   Q:EXIT   D
  568    .S RSUB=$ O(^DD(FILE NUM,"GL",R EG,CNT,"") )
  569    .U 0 W !, "GETSUB():  $O(^DD(", FILENUM,", ""GL"",",R EG,",",CNT ,")= ",$O( ^DD(FILENU M,"GL",REG ,CNT,""))
  570    .S:RSUB=( REG+SUBVAL ) RTN=CNT, EXIT=1
  571    Q RTN
  572    ;
  573    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  574    ; GETFIEL DS(FILENUM , SUB) RET RIEVES THE  FIELD NAM ES FROM TH E DATA DIC TIONARY
  575    ; USING T HE "GL" CR OSS-REFERE NCES.
  576    ;
  577    ; NOTE: T HERE ARE T IMES WHEN  THE CNT VA LUE IS MIS SING BECAU SE THE FIL E WAS CREA TED
  578    ; INCORRE CTLY, SO T HE FUNCTIO N TAKES TH AT INTO AC COUNT.
  579    ; EXAMPLE :
  580    ;                        ^DD(74 1210.14,"G L",1,12,1. 12)=""
  581    ;                        THE "1 3" COUNT W AS OMITTED  IN THE NO DE.
  582    ;                        ^DD(74 1210.14,"G L",1,14,1. 14)=""
  583    ;                        ^DD(74 1210.14,"G L",1,15,1. 15)=""
  584    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  585    ; NOTE: T HERE ARE S PECIFIC FI ELD INDEXE S WITHIN S OME GLOBAL S THAT ARE  MISSING,
  586    ;               AND  THESE MUST  BE HANDLE D IN ORDER  TO RETRIE VE ALL OF  THE VALID  FIELDS.
  587    ;               EXAM PLE: ^CHMX CLF(I,1),  FIELD 13 D OES NOT EX IST
  588    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  589    ;
  590   GETFIELDS( FILENUM,SU B,MULT)
  591    ; FILENUM                         USER PRO VIDED FILE  NUMBER FO R THE DATA  DICTIONAR Y
  592    ; SUB                             THE LAST  SUBSCRIPT  IN THE NO DE ADDRESS
  593    ; MULT                            "MULTIPL E" FLAG
  594    N IDX,REG ,FIELDS,CN T,EXIT,RCH ,RIDX
  595    U 0 W:VER BOSE !,?15 ,"GETFIELD S:  GET FI ELD NAMES:   FILENUM=  ",FILENUM ,"  SUBSCR IPT= ",SUB ,"  MULT=  ",MULT
  596    S FIELDS= "",EXIT=0, RIDX=""
  597    I 'MULT   D
  598    .F CNT=1: 1  S RIDX= $O(^DD(FIL ENUM,"GL", SUB,CNT,RI DX)) Q:EXI T  D
  599    ..Q:(FILE NUM=741210 .14)&(SUB= 1)&(CNT=13 )                                                   ;  IF THE SPE CIFIED FIE LD # DOES  NOT EXIST,  CONTINUE
  600    ..S:RIDX= "" EXIT=1
  601    ..Q:EXIT
  602    ..S REG=$ P(^DD(FILE NUM,RIDX,0 ),"^",1)                                                       ;  GET THE FI ELD NAMES
  603    ..S:FIELD S'="" FIEL DS=FIELDS_ "^"
  604    ..S FIELD S=FIELDS_R EG
  605    E  D
  606    .S:FILENU M=741210.1 47101 SUB= 0                                                                       ; 10 1 NODE IS  DEFINED DI FFERENTLY
  607    .S RIDX=S UB                                                                                                              ; MULTIP LE FIELDS  USE SUBSCR IPTS FOR I NDEXING
  608    .F CNT=1: 1  S RIDX= $O(^DD(FIL ENUM,"GL", SUB,CNT,RI DX))  Q:'R IDX  D       
  609    ..S REG=$ P(^DD(FILE NUM,RIDX,0 ),"^",1)                                                       ;  GET THE FI ELD NAMES
  610    ..S:FIELD S'="" FIEL DS=FIELDS_ "^"
  611    ..S FIELD S=FIELDS_R EG
  612    U 0 W:VER BOSE !,?15 ,"GETFIELD S:  FIELD  CNT= ",$L( FIELDS,"^" )
  613    Q FIELDS
  614    ;
  615    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  616    ; WRITEXM L() WRITES  THE DATA  TO THE PRO VIDED FILE  AND DISPL AY 
  617    ; (IF VER BOSE FLAG  IS SET)
  618    ; IN ORDE R TO MAKE  IT POSSIBL E TO WRITE  THE DATA  TO A TARGE T, THE
  619    ; BUFFER  DESCRIPTOR  CONTAINS  THE IEN FO R THE BUFF ER (^CHMXC LF(1234567 ))
  620    ; AND SET  IT TO THE  VARIABLE  "IDX" (^CH MXCLF(IDX) ). THIS AL LOWS THE
  621    ; LOAD RO UTINE TO A SSIGN A SP ECIFIC IEN  FOR THE T ARGET, AND  WRITE THE
  622    ; DATA FO R ALL NODE S TO THE T ARGETED LO CATION.
  623    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  624    ; 
  625   WRITEXML(G NAME,TIO,F IELDS,DATA )
  626    ;  GNAME                 THE NO DE DESCRIP TOR (I.E.  ^CHMXCLF(1 234567,70, 1,0)) THAT  IS BEING  WRITTEN
  627    ;  TIO                   TARGET  IO DESTIN ATION
  628    ;  FIELDS                FIELD  DESCRIPTOR S FROM THE  ^DD DATA  DICTIONARY
  629    ;  DATA                  DATA I N THE FIEL DS 
  630    N CNT,FNA ME,FDATA,D LEN,FLDLEN ,RCH,GNAME 1
  631    S DLEN=$L (DATA,"^")
  632    S FLDLEN= $L(FIELDS, "^")
  633    S GNAME1= $$NUKEIDX( GNAME)
  634    U TIO W ! ,?10,"<"_G NAME1_":"_ "FIELDS="_ FLDLEN_">"                                                   ; RE PLACE THE  IEN INDEX  WITH THE " IEN" STRIN G
  635    U TIO W ! ,?15,"<FIE LDS^"_FIEL DS_">"
  636    U TIO W ! ,?15,"<DAT A^"_DATA_" >"
  637    U 0 W:VER BOSE !,"WR ITEXML: FI ELD CNT= " ,FLDLEN,"                <"_GNAM E1_">","      DATA= " ,DATA
  638    I FLDLEN= 1  D
  639    .S FDATA= DATA,FNAME =FIELDS
  640    .U 0 W:VE RBOSE !,?1 0,"WRITEXM L:  <"_1_" :"_FNAME_"   :"_FDATA _">" 
  641    .U TIO W  !,?15,"<"_ 1_":"_FNAM E_"  :"_FD ATA_">"
  642    E  D
  643    .F CNT=1: 1:FLDLEN S  FNAME=$P( FIELDS,"^" ,CNT)   Q: FNAME=""   D                     ; OUTPUT T HE FIELD N AME NAMES  AND DATA
  644    ..S FDATA =$S($P(DAT A,"^",CNT) ="":"*",1: $P(DATA,"^ ",CNT))                                  ;  OUTPUT EAC H FIELD ON  IT'S OWN  LINE(NULL  DATA IS "O K")  
  645    ..U 0 W:V ERBOSE !,? 10,"WRITEX ML:  <"_CN T_":"_FNAM E_"  :"_FD ATA_">" 
  646    ..U TIO W  !,?15,"<" _CNT_":"_F NAME_"  :" _FDATA_">"
  647    ;U 0 R RC H
  648    Q
  649    ;
  650    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  651    ; WRTXREF (NODE,TIO)  WRITES TH E GLOBAL X REFS TO TH E XML FILE
  652    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  653    ;
  654   WRTXREF(BU FNAME,FNUM BER,XREF,T IO,IEN)
  655    ;  XREF                  THE XR EF NODE TO  BE WRITTE N
  656    ;  TIO                   THE TA RGET FILE
  657    U 0 W:VER BOSE !,"WR ITE ",XREF
  658    U TIO W ! ,?15,"<"_X REF_">"
  659    ;U 0 R RC H
  660    Q
  661    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  662    ; NUKEIDX () (NUKE I DX) FUNCTI ON WILL RE MOVE THE A CTUAL IEN  VALUE FROM  THE
  663    ; BUFFER  DATA AND R EPLACE IT  WITH THE S TRING "IEN ", MAKING  IT POSSIBL E
  664    ; TO ASSI GN THE TAR GET BUFFER  INDEX (S  IEN=TARGET  BUFFER IN DEX) AND U SE
  665    ; THAT TO  WRITE THE  DATA TO A  NEW SET O F NODES.
  666    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  667    ;
  668   NUKEIDX(GN AME)
  669    ; GNAME                  THE NA ME OF THE  BUFFER TO  BE MODIFIE D
  670    N TMP,IEN ,IENL,SUBS ,BUFFER,ST R,NGNAME
  671    S STR="IE N"
  672    S BUFFER= $P(GNAME," (",1)                                                                                                ; GET TH E BUFFER N AME
  673    S SUBS=$P (GNAME,"(" ,2)                                                                                                  ; GET TH E ENTIRE S UBSCRIPT S TRING
  674    S IEN=$P( SUBS,",",1 )                                                                                                    ; GET TH E IEN
  675    S IENL=$L (IEN)                                                                                                                    ; GET THE  LENGTH OF  THE IEN
  676    S SUBS=$E (SUBS,IENL +1,$L(SUBS ))                                                                               ; EXTR ACT THE IE N
  677    S SUBS=ST R_SUBS                                                                                                                   ; INSERT T HE "IEN" S TRING INTO  SUBSCRIPT  STRING
  678    S NGNAME= BUFFER_"(" _SUBS                                                                                                ; RECONS TRUCT THE  GLOBAL NAM E
  679    Q NGNAME
  680    ;
  681    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  682    ; GETIEN( NODE) EXTR ACTS AND R ETURNS THE  IEN INDEX  FROM THE  NODE ADDRE SS
  683    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  684    ;
  685   GETIEN(NOD E)
  686    ;  NODE                  THE NO DE ADDRESS  FROM WHIC H TO EXTRA CT THE IEN  INDEX
  687    N IDX,TMP ,SIDX,EIDX                                                                                                      ; START/ END POINTE RS FOR THE  INDEX VAL UE 
  688    I $L(NODE ,",")<2  D                                                                                                      ; IF THE RE ARE NO  "," IN THE  PROVIDED  NODE
  689    .S SIDX=$ L($P(NODE, "(",1))+2, EIDX=$L(NO DE)-1                                               ;  USE THE ST ART AND EN D TO EXTRA CT IDX
  690    .S IDX=$E (NODE,SIDX ,EIDX)       
  691    E  D                                                                                                                                       ;  ELSE USE T HE "," DEL IMITERS
  692    .S TMP=$P (NODE,",", 1)
  693    .S IDX=$P (TMP,"(",2 )                                                                                                    ; EXTRAC T THE INDE X VALUE FR OM THE NOD E
  694    Q IDX
  695    ;
  696    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  697    ; ENDOFNO DE(IEN,NOD E) IS A BO OLEAN CHEC K FOR DETE CTING THE  END OF THE
  698    ; CURRENT  NODE BASE D ON THE I EN INDEX.  IF THE IEN  OF THE CU RRENT NODE
  699    ; DOES NO T MATCH TH E WORKING  IEN, RETUR N TRUE.
  700    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  701    ;
  702   ENDOFNODE( IEN,NODE)
  703    ;  IEN                   THE CU RRENT WORK ING INDEX
  704    ;  NODE                  THE NO DE TO CHEC
  705    S IDX=$$G ETIEN(NODE )
  706    Q IDX'=IE N                                                                                                                                ;  COMPARE TH E "WORKING  NODE" IND EX TO THE  INDEX FROM  THE NODE
  707    ;
  708    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  709    ;******** ********** ********** ********** ********** ********** ********** **
  710    ; THE FOL LOWING FUN CTIONS PER FORM THE D ATA EXTRAC TION TO PO PULATE THE
  711    ; XML FIL E. EACH FU NCTION IS  SPECIFIC T O ONE CLAI M BUFFER. 
  712    ;******** ********** ********** ********** ********** ********** ********** **
  713    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  714    ;
  715    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  716    ; FILEBUF () CREATES  THE XML O UTPUT FOR  THE ^CHMXC L() BUFFER
  717    ;  "^CHMX CL")="7412 10.04^CLAI M FILE"                                       
  718    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  719    ;
  720   FILEBUF(ID X,HANDLE)
  721    ; IDX           THE  INDEX TO ^ CHMXCL() A SSOCIATED  WITH THE C LAIM
  722    ; HANDLE        THE  FILE HANDL E FOR WRIT ING THE XM L DATA
  723    N GNAME,F OPENDT,EDI ARR,NAMLEN
  724    Q:('$D(ID X))!('$D(^ CHMXCL(IDX )))
  725    S GNAME=" ^CHMXCL("_ IDX_")"
  726    S NAMLEN= $L(GNAME)- 1
  727    D STARTEL E(GNAME,HA NDLE)                                                    ; ELEMEN T START FI ELDS FOR X ML FILE
  728    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                                    ; DISP LAY / WRIT E GLOBAL I NFO 
  729    Q
  730    ;
  731    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  732    ; ; TRANS ACTION BUF FER   ^CHM XCLA()
  733    ; ^CHMXCL A = "74121 0.06^TRANS ACTION"
  734    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  735    ;
  736   TRXBUF(IDX ,HANDLE)
  737    ; IDX  TH E ^CHMXCL( ) INDEX TO  BE MOVED
  738    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  739    N GNAME,B ATCH,NAMLE N
  740    Q:('$D(ID X))!('$D(^ CHMXCLA(ID X)))
  741    S GNAME=" ^CHMXCLA(" _IDX_")"
  742    S NAMLEN= $L(GNAME)- 1
  743    D STARTEL E(GNAME,HA NDLE)                                                    ; ELEMEN T START FI ELDS FOR X ML FILE
  744    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                                    ; DISP LAYS / WRI TES GLOBAL  DATA
  745    Q
  746    ;
  747    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  748    ; PROVIDE R BUFFER       ^CHMXC LB()
  749    ; ^CHMXCL B = "74121 0.08^PROVI DER"
  750    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  751    ;
  752   PROVBUF(ID X,HANDLE)
  753    ; IDX  TH E ^CHMXCLB () INDEX T O BE MOVED
  754    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  755    N GNAME,T BATCH,NAML EN
  756    Q:('$D(ID X))!('$D(^ CHMXCLB(ID X)))
  757    S GNAME=" ^CHMXCLB(" _IDX_")"
  758    S NAMLEN= $L(GNAME)- 1
  759    D STARTEL E(GNAME,HA NDLE)                                  ; EL EMENT STAR T FIELDS F OR XML FIL E
  760    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                  ;  TEST FUNCT ION DISPLA YS ON TERM INAL             
  761    Q
  762    ;
  763    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  764    ; PATIENT  BUFFER        ^CHMXC LC()
  765    ; ^CHMXCL C = "74121 0.1^PATIEN T"
  766    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  767    ;
  768   PATBUF(IDX ,HANDLE)
  769    ; IDX  TH E ^CHMXCLC () INDEX T O BE MOVED
  770    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  771    N GNAME,P BATCH,NAML EN
  772    Q:('$D(ID X))!('$D(^ CHMXCLC(ID X)))
  773    S GNAME=" ^CHMXCLC(" _IDX_")"
  774    S NAMLEN= $L(GNAME)- 1
  775    D STARTEL E(GNAME,HA NDLE)                                  ; EL EMENT STAR T FIELDS F OR XML FIL E                               
  776    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                  ;  DISPLAYS /  WRITE XML  FILE
  777    Q
  778    ;
  779    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  780    ; CLAIM B UFFER ^CHM XCLE()
  781    ; ^CHMXCL E = "74121 0.12^CLAIM "
  782    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  783    ;
  784   CLMBUF(IDX ,HANDLE)
  785    ; IDX           THE  ^CHMXCLE()  INDEX TO  BE MOVED
  786    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  787    N GNAME,B BATCH,OCRP DI,PDI,HDR CLMID,SUBC TRL,ADMITD T,PREAUTH, PCN,RECORD ,TPID,CLI, IDXSTR,NAM LEN
  788    Q:('$D(ID X))!('$D(^ CHMXCLE(ID X)))
  789    S XMLNAME ="^CHMXCLE ("_IDX_")"
  790    S GNAME=" ^CHMXCLE(" _IDX_",0)"
  791    S NAMLEN= $L(GNAME)- 1
  792    U 0 W:VER BOSE !,"CL AIMBUF:  G NAME= ",GN AME,"  NAM LEN= ",NAM LEN
  793    D STARTEL E(XMLNAME, HANDLE)                                         ; ELEM ENT START  FIELDS FOR  XML FILE                                         
  794    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                           ; TE ST FUNCTIO N DISPLAYS  ON TERMIN AL
  795    D CLMXREF S(IDX)                                                              ; WRITE  THE CLAIM  BUFFER XRE FS TO THE  XML FILE
  796    Q
  797   CLMXREFS(I DX)                                                        ; SET  UP THE COM MON VARIAB LES TO BE  USED
  798    S IEN=IDX                                                                              ; THE CLAI M IEN INDE X (^CHMXCL F(IEN))
  799    S GNAME=" ^CHMXCLE("                                                 ; THE  BUFFER NAM E
  800    S FILENUM =$$GETFNUM (GNAME)                                         ; GET  THE FILE N UMBER BASE D ON THE F ILE NAME
  801    U 0 W:VER BOSE !,?5, "LINEBUF:   COMMON: I DX= ",IDX, "  IEN= ", IEN,"  GNA ME= ",GNAM E,"  FILE  NUMBER: ", FILENUM
  802   STEXREF                                                                                 ; WRTXREF( BUFNAME,FN UMBER,XREF ,TIO,IEN)
  803    U HANDLE  W !,?5,"<b uffer>"_GN AME_" FILE  #:"_FILEN UM_": CROS SREFERENCE  : IDX="_I EN_"</buff er>"
  804   ENODE0                                                                         ; ^CHMXC LF("B",325 31121,8109 7092)="" ( PTR->^CHMX CLE())
  805    I $D(^CHM XCLE(IEN,0 ))  D
  806    .N CPTR,H DRID,SUBCT RL,PCN
  807    .S CPTR=$ P(^CHMXCLE (IEN,0),"^ ",1)                        ; PO INTER TO ^ CHMXCLC()
  808    .I CPTR'= ""  D
  809    ..S XREF= GNAME_"""B "","_CPTR_ ",IEN)=""" ""
  810    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE0: XREF=  ",XREF 
  811    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  812    .S HDRID= $P(^CHMXCL E(IEN,0)," ^",17)                      ; TH E 36 CHAR  CLAIM ID
  813    .I HDRID' =""  D
  814    ..S XREF= GNAME_"""E "","_HDRID _",IEN)="" """
  815    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE0: XREF=  ",XREF 
  816    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  817    .S SUBCTR L=$P(^CHMX CLE(IEN,0) ,"^",14)                    ; SU BMITTER CO NTROL NUMB ER
  818    .I SUBCTR L'=""  D
  819    ..S XREF= GNAME_"""F "","_SUBCT RL_",IEN)= """""
  820    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE0: XREF=  ",XREF 
  821    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  822    .S PCN=$P (^CHMXCLE( IDX,0),"^" ,2)                                  ;PATIE NT CONTROL  NUMBER
  823    .I PCN'=" "  D
  824    .I $D(^CH MXCLE("I", PCN))  D
  825    ..S XREF= GNAME_"""I "","_PCN_" ,IEN)="""" "
  826    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  827   ENODE1                                                                                  ; ADMISSIO N NODE
  828    I $D(^CHM XCLE(IEN,1 ))  D
  829    .N ADMITD T                                                 
  830    .S ADMITD T=$P(^CHMX CLE(IDX,1) ,"^",3)                     ; AD MISSION DA TE 
  831    .I (ADMIT DT'="")  D
  832    ..S XREF= GNAME_"""G "","_ADMIT DT_",IEN)= """""
  833    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE1: XREF=  ",XREF 
  834    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  835   ENODE3                                                                                  ; PRE-AUTH  NODE
  836    I $D(^CHM XCLE(IEN,3 ))  D
  837    .N PREAUT H,RECORD
  838    .S PREAUT H=$P(^CHMX CLE(IEN,3) ,"^",4)                              ;PRE-A UTHORIZATI ON NUMBER
  839    .I PREAUT H'=""  D
  840    ..S XREF= GNAME_"""H "","_PREAU TH_",IEN)= """""
  841    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE3: XREF=  ",XREF 
  842    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  843    .S RECORD =$P(^CHMXC LE(IEN,3), "^",6)                               ;MEDIC AL RECORD  NUMBER
  844    .I RECORD '=""  D
  845    ..S XREF= GNAME_"""J "","_RECOR D_",IEN)=" """"
  846    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE3: XREF=  ",XREF 
  847    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  848   ENODE100                                                                                ; ^CHMXCLE ("D",PDI,I EN)
  849    I $D(^CHM XCLE(IEN,1 00))  D
  850    .N PDI
  851    .S PDI=$P (^CHMXCLE( IEN,100)," ^",2)                       ; FI NAL PDI VA LUE ASSIGN ED (WITH L ABEL TYPE)
  852    .I PDI'=" "  D
  853    ..S XREF= GNAME_"""D "","_PDI_" ,IEN)="""" "
  854    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO DE100: XRE F= ",XREF 
  855    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  856   NONFMAN                                                                                 ; THESE XR EFS ARE BU ILT BY THE  EDI LOAD  PROCESS
  857    N CLI,IDX STR                                                                 ; THEY A RE NOT PAR T OF THE F ILEMAN DEF INITIONS
  858    S PDI=$P( ^CHMXCLE(I EN,100),"^ ",2)                        ; FI NAL PDI VA LUE ASSIGN ED (WITH L ABEL TYPE)
  859    I PDI'=""   D
  860    .S PCN=0, PCN=$O(^CH MXCLE("PDI ",PDI,PCN) )
  861    .I PCN'=" "  D
  862    ..S CLI=0 ,CLI=$O(^C HMXCLE("PD I",PDI,PCN ,CLI))
  863    ..S IDXST R="",IDXST R=$O(^CHMX CLE("PDI", PDI,PCN,CL I,IDXSTR))
  864    ..S XREF= GNAME_"""P DI"","_PDI _","""_PCN _""","_CLI _","""_IDX STR_""")"
  865    ..U 0 W:V ERBOSE !,? 5,"CLAIM B UFFER:  NO N-FM: XREF = ",XREF 
  866    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  867    .S PCN=$P (^CHMXCLE( IDX,0),"^" ,2)
  868    .I PCN'=" "  D
  869    ..S CLI=0 ,CLI=$O(^C HMXCLE("CL M-CTRL-NO" ,PCN,PDI,C LI))
  870    ..S IDXST R="",IDXST R=$O(^CHMX CLE("CLM-C TRL-NO",PC N,PDI,CLI, IDXSTR))
  871    ..S XREF= GNAME_"""C LM-CTRL-NO "","""_PCN _""","_PDI _","_CLI_" ,"""_IDXST R_""")"
  872    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  873    Q
  874    ;
  875    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  876    ; LINE BU FFER  ^CHM XCLF()  US ES THE ^CH MXCLE() PO INTER TO E XTRACT MUL TIPLE LINE S
  877    ; ^CHMXCL F = "74121 0.14^SERVI CE LINE"
  878    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  879    ;
  880   LINEBUF(ID X,HANDLE)
  881    ; IDX           THE  ^CHMXCLE()  POINTER T O THE ^CHM XCLF() IND EX(S) TO B E MOVED
  882    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  883    N GNAME,E PTR,PAYPTR ,FIDX,XMLN AME,XREF,R EVCODE,IEN ,PYRCODE
  884    N EXIT,JD X,KDX,SVCG RP,EI
  885    Q:(IDX="" )                                                                            ; EXIT IF  INVALID PO INTER
  886    S EI=IDX                                                                               ; THE ^CHM XCLE() IND EX
  887    U 0 W:VER BOSE !,?5, "LINEBUF:   INPUT: ID X= ",IDX,"   HANDLE=  ",HANDLE,"   EI= ",EI
  888    S FIDX=0
  889    F  S FIDX =$O(^CHMXC LF("B",IDX ,FIDX)) Q: FIDX=""  D
  890    .S XMLNAM E="^CHMXCL F("_FIDX_" )"
  891    .S GNAME= "^CHMXCLF( "_FIDX_",0 )"
  892    .S NAMLEN =$L(GNAME) -1
  893    .U 0 W:VE RBOSE !,"L INEBUF:  G NAME= ",GN AME,"  NAM LEN= ",NAM LEN
  894    .D STARTE LE(XMLNAME ,HANDLE)                               ; EL EMENT STAR T FIELDS F OR XML FIL E                                        
  895    .D GLBLDM P(GNAME,HA NDLE,NAMLE N)                          ; TE ST FUNCTIO N DISPLAYS  ON TERMIN AL
  896    .D LINEXR EFS(EI)
  897    Q
  898   LINEXREFS( IDX)                                                       ; SET  UP THE COM MON VARIAB LES TO BE  USED
  899    S IEN=0,I EN=$O(^CHM XCLF("B",I DX,IEN))           ;  THE CLAIM  IEN INDEX  (^CHMXCLF( IEN))
  900    S GNAME=" ^CHMXCLF("                                                 ; THE  BUFFER NAM E
  901    S FILENUM =$$GETFNUM (GNAME)                                         ; GET  THE FILE N UMBER BASE D ON THE F ILE NAME
  902    U 0 W:VER BOSE !,?5, "LINEBUF:   COMMON: I DX= ",IDX, "  IEN= ", IEN,"  GNA ME= ",GNAM E,"  FILE  NUMBER: ", FILENUM
  903   STARTXREF                                                                      ; WRTXRE F(BUFNAME, FNUMBER,XR EF,TIO,IEN )
  904    U HANDLE  W !,?5,"<b uffer>"_GN AME_" FILE  #:"_FILEN UM_": CROS SREFERENCE  : IDX="_I EN_"</buff er>"
  905   FNODE0                                                                         ; ^CHMXC LF("B",325 31121,8109 7092)="" ( PTR->^CHMX CLE())
  906    I $D(^CHM XCLF(IEN,0 ))  D
  907    .S EPTR=$ P(^CHMXCLF (IEN,0),"^ ",1)                        ; PO INTER TO ^ CHMXCLE()
  908    .I EPTR'= ""  D
  909    ..S XREF= GNAME_","" B"","_EPTR _",IEN)="" """
  910    ..U 0 W:V ERBOSE !,? 5,"LINEBUF :  NODE0:  XREF= ",XR EF 
  911    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  912   FNODE1                                                                                  ; ^CHMXCLF ("B",9999, 81097092)= ""
  913    I $D(^CHM XCLF(IEN,1 )) D
  914    .S REVCOD E=$P(^CHMX CLF(IEN,1) ,"^",1)
  915    .I REVCOD E'=""  D
  916    ..S XREF= GNAME_"""C "","_REVCO DE_",IEN)= """""
  917    ..U 0 W:V ERBOSE !,? 5,"LINEBUF :  NODE1:  XREF= ",XR EF 
  918    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,I EN)
  919   FNODE70                                                                                 ; ^CHMXCLF (81097092, 70,"B","05 202",1)=""
  920    I $D(^CHM XCLF(IEN,7 0))  D
  921    .N EXIT   S EXIT=0
  922    .F JDX=1: 1  Q:EXIT   D
  923    ..S:'$D(^ CHMXCLF(IE N,70,JDX,0 )) EXIT=1
  924    ..Q:EXIT
  925    ..S PYRCO DE=$P(^CHM XCLF(IEN,7 0,JDX,0)," ^",1)
  926    ..I PYRCO DE'=""  D
  927    ...S XREF =GNAME_"IE N,""B"","_ PYRCODE_", "_JDX_")=" """"
  928    ...U 0 W: VERBOSE !, ?5,"LINEBU F:  NODE70 : XREF= ", XREF 
  929    ...D WRTX REF(GNAME, FILENUM,XR EF,HANDLE, IEN)
  930   FNODE80                                                                                         ;  THE POINTE R TO ^CHMP AY()
  931    I $D(^CHM XCLF(IEN,8 0))  D
  932    .S PAYPTR =$P(^CHMXC LF(IEN,80) ,"^",1)            ;  POINTER TO  ^CHMPAY()
  933    .I PAYPTR '=""  D
  934    ..S XREF= GNAME_"""D "","_PAYPT R_",IEN)"
  935    ..U 0 W:V ERBOSE !,? 5,"LINEBUF :  NODE80:  XREF= ",X REF 
  936    ..D WRTXR EF(GNAME,F ILENUM,XRE F,HANDLE,F IDX)
  937   FNODE101                                                                       ;  ^CHMX CLF(810970 92,70,1,10 1,"B","CO" ,1)=""
  938    I $D(^CHM XCLF(IEN,7 0,1,101))   D
  939    .N QUIT,E XITK
  940    .S QUIT=0
  941    .F JDX=1: 1  Q:QUIT   D
  942    ..S EXITK =0
  943    ..F KDX=1 :1  Q:EXIT K  D
  944    ...I $D(^ CHMXCLF(IE N,70,JDX,1 01,KDX,0))   D
  945    ....S SVC GRP=$P(^CH MXCLF(IEN, 70,JDX,101 ,KDX,0),"^ ",1)           ; POIN TER TO ^CH MPAY()
  946    ....I SVC GRP'=""  D
  947    .....S XR EF=GNAME_" IEN,70,"_J DX_"101,"_ """B"","_S VCGRP_","_ KDX_")=""" ""
  948    .....U 0  W:VERBOSE  !,?5,"LINE BUF:  NODE 101: XREF=  ",XREF 
  949    .....D WR TXREF(GNAM E,FILENUM, XREF,HANDL E,FIDX)
  950    ...I '$D( ^CHMXCLF(I EN,70,JDX, 101,KDX,0) ) S EXITK= 1
  951    ...I '$D( ^CHMXCLF(I EN,70,JDX, 101)) S QU IT=1
  952    Q 
  953    ;
  954    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  955    ; IMAGE B UFFER ^CHM IMAGE(PDI)
  956    ; ^CHMIMA GE = "7410 00.1^IMAGE "
  957    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  958    ;
  959   IMAGBUF(PD I,HANDLE)
  960    ; PDI           CLAI M PDI IS I NDEX TO ^C HMIMAGE
  961    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  962    N GNAME,N AMLEN
  963    S GNAME=" ^CHMIMAGE( "_PDI_")"
  964    S NAMLEN= $L(GNAME)- 1
  965    D STARTEL E(GNAME,HA NDLE)                                           ; ELEM ENT START  FIELDS FOR  XML FILE      
  966    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                           ; TE ST FUNCTIO N DISPLAYS  ON TERMIN AL
  967    I $D(^CHM IMAGE("B", PDI)) D                                         ; SEE  IF "B" XRE F IS POPUL ATED
  968    .S GNAME= "^CHMIMAGE (""B"","_P DI_")"
  969    .S NAMLEN =$L($P(GNA ME,"(",1))
  970    .D GLBLDM P(GNAME,HA NDLE,NAMLE N)                          ; PO PULATED, S O OUTPUT X REF 
  971    Q
  972    ;
  973    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  974    ;IMG BUFF ER ^CHMIMG (PDI)
  975    ; ^CHMIMG  = "741000 .2^IMAGE"
  976    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  977    ; THE "F"  XREF CONT AINS ALL O F THE BATC H->PDI REF ERENCES
  978    ; IT IS I MPOSSIBLE  TO MOVE AL L OF THE P DIs ASSOCI ATED WITH  THE
  979    ; BATCH F ILE FROM O NE ENVIRON MENT TO AN OTHER, SO  THIS XREF  IS 
  980    ; IGNORED .
  981    ;-------- ---------- ---------- ---------- ---------- ---------- ---------- -
  982    ; S BATCH =$P(^CHMIM G(PDI,0)," ^",18)                      ; PO INTER TO B ATCH FILE
  983    ;I BATCH' =""  D
  984    ;.I $D(^C HMIMG("F", BATCH))  D
  985    ;..S GNAM E="^CHMIMG (""F"","_B ATCH_")"
  986    ;..D GLBL DMP(GNAME, HANDLE,NAM LEN)                        ; PO PULATED, S O OUTPUT X REF
  987    ;-------- ---------- ---------- ---------- ---------- ---------- ---------- -
  988    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  989    ;
  990   IMGBUF(PDI ,HANDLE)
  991    ; PDI           CLAI M PDI IS I NDEX TO ^C HMIMG()
  992    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE
  993    N GNAME,N AMLEN,DOCN UM,DOCID,I MGJOB,BATC H,PDIDATE, X,VENDOR
  994    S GNAME=" ^CHMIMG("_ PDI_")"
  995    S NAMLEN= $L(GNAME)- 1
  996    D STARTEL E(GNAME,HA NDLE)                                           ; ELEM ENT START  FIELDS FOR  XML FILE      
  997    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                           ; TE ST FUNCTIO N DISPLAYS  ON TERMIN AL
  998    I $D(^CHM IMG("B",PD I)) D                                           ; SEE  IF "B" XRE F IS POPUL ATED
  999    .S GNAME= "^CHMIMG(" "B"","_PDI _")"
  1000    .S NAMLEN =$L($P(GNA ME,"(",1))
  1001    .D GLBLDM P(GNAME,HA NDLE,NAMLE N)                          ; PO PULATED, S O OUTPUT X REF
  1002    S DOCNUM= $P(^CHMIMG (PDI,"DOC" ),"^",1)           ;  DOCUMENT N UMBER
  1003    I DOCNUM' =""  D
  1004    .I ($D(^C HMIMG("D", PDI))) D              ; SEE IF " D" XREF IS  POPULATED
  1005    ..S GNAME ="^CHMIMG( ""D"","_DO CNUM_")"
  1006    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)                         ; PO PULATED, S O OUTPUT X REF 
  1007    S DOCID=$ P(^CHMIMG( PDI,"DOC") ,"^",10)           ;  MANUAL DOC UMENT ID
  1008    I DOCID'= ""  D
  1009    .I ($D(^C HMIMG("E", DOCID)))   D
  1010    ..S GNAME ="^CHMIMG( ""E"","_DO CID_")"
  1011    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)                         ; PO PULATED, S O OUTPUT X REF
  1012    S IMGJOB= $P(^CHMIMG (PDI,"TRAC K"),"^",7)         ;  IMAGE JOB  TYPE
  1013    I IMGJOB' =""  D
  1014    .I $D(^CH MIMG("G",I MGJOB))  D
  1015    ..S GNAME ="^CHMIMG( ""G"","_IM GJOB_")"
  1016    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)                         ; PO PULATED, S O OUTPUT X REF
  1017    S PDIDATE =$P(^CHMIM G(PDI,0)," ^",21)             ;  DATE PDI C REATED
  1018    I PDIDATE '=""  D
  1019    .I $D(^CH MIMG("AD", PDIDATE))   D
  1020    ..S GNAME ="^CHMIMG( ""AD"","_P DIDATE_")"
  1021    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)                         ; PO PULATED, S O OUTPUT X REF
  1022    S VENDOR= $P(^CHMIMG (PDI,"TRAC K"),"^",3)         ;  SUBMISSION  VENDOR
  1023    I VENDOR' =""  D
  1024    .I $D(^CH MIMG("AU", VENDOR))   D
  1025    ..S GNAME ="^CHMIMG( ""AU"","_V ENDOR_")"
  1026    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)                         ; PO PULATED, S O OUTPUT X REF
  1027    ;D ENDELE (GNAME,HAN DLE)                                            ; ELEM ENT CLOSE  FIELDS FOR  XML FILE      
  1028    Q
  1029    ;
  1030    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1031    ; PAY BUF FER   ^CHM PAY()
  1032    ; ^CHMPAY  = "741000 ^PAYMENT"
  1033    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1034    ; 
  1035   PAYBUF(EID X,HANDLE)
  1036    ; EIDX          "I"  INDEX FOR  THE ^CHMED I() FILE ( MAY CONTAI N MORE THA N 1 ^CHMPA Y() NODE)
  1037    ; HANDLE        THE  FILE HANDL E TO WRITE  THE XML F ILE   
  1038    N GNAME,H ACCLM,PDI, SPNSR,CMPL TDT,VENDOR ID,NAMLEN, JIDX,PAYI, IDX
  1039    S JIDX=0
  1040    F  S JIDX =$O(^CHMED I(EIDX,1,J IDX)) Q:JI DX=""  D
  1041    .S PAYI=$ P(^CHMEDI( EIDX,1,JID X,0),"^",1 )                ; RE TRIEVE ALL  ASSOCIATE D PAY FILE  NODES
  1042    .S GNAME= "^CHMPAY(" _PAYI_")"
  1043    .S NAMLEN =$L(GNAME) -1
  1044    .D STARTE LE(GNAME,H ANDLE)                                                   ; START  ELEMENTS F OR THE XML  FILE
  1045    .D GLBLDM P(GNAME,HA NDLE,NAMLE N)                                   ; TEST  FUNCTION  DISPLAYS O N TERMINAL
  1046    .S GNAME= "^CHMPAY("
  1047    .S NAMLEN =$L($P(GNA ME,"(",1))
  1048    .S IDX=PA YI                                                                           ; SETUP TH E "I" INDE X FOR ^CHM PAY()
  1049    .S HACCLM =$P(^CHMPA Y(IDX,0)," ^",1)                                ; PREP  FOR "B" X REF
  1050    .I HACCLM '="" D
  1051    ..I $D(^C HMPAY("B", HACCLM))   D
  1052    ...S GNAM E="^CHMPAY (""B"",""" _HACCLM_"" ")"              ; HA C CLAIM #  XREF
  1053    ...D GLBL DMP(GNAME, HANDLE,NAM LEN)                                                  
  1054    .S PDI=$P ($P(^CHMPA Y(IDX,0)," ^",4),"*", 1)
  1055    .I PDI'=" "  D
  1056    ..I $D(^C HMPAY("C", PDI))  D                                        ; PDI  XREFS
  1057    ...S GNAM E="^CHMPAY (""C"","_P DI_")"
  1058    ...D GLBL DMP(GNAME, HANDLE,NAM LEN)                                                  
  1059    .S SPONSO R=$P(^CHMP AY(IDX,0), "^",21)                     ; SP ONSOR POIN TER TO ^AH CHVA()
  1060    .I SPONSO R '=""  D
  1061    ..I $D(^C HMPAY("D", SPONSOR,ID X))  D
  1062    ...S GNAM E="^CHMPAY (""D"","_S PONSOR_"," _IDX_")" ;  ONLY INTE RESTED IN  THIS CLAIM         
  1063    ...D GLBL DMP(GNAME, HANDLE,NAM LEN)                                                  
  1064    .S CMPLTD T=$P(^CHMP AY(IDX,0), "^",10)                     ; DA TE DETERMI NED COMPLE TE
  1065    .I CMPLTD T'=""  D
  1066    ..I $D(^C HMPAY("E", CMPLTDT))   D
  1067    ...S GNAM E="^CHMPAY (""E"","_C MPLTDT_")"
  1068    ...D GLBL DMP(GNAME, HANDLE,NAM LEN)                                                  
  1069    .S VENDOR ID=$P(^CHM PAY(IDX,0) ,"^",3)                     ; VE NDOR ID
  1070    .I VENDOR ID'=""  D
  1071    ..I $D(^C HMPAY("AD" ,VENDORID) )  D
  1072    ...S GNAM E="^CHMPAY (""AD"","_ VENDORID_" ,"_IDX_")"       ; ON LY INTERES TED IN XRE F FOR THIS  CLAIM IND EX
  1073    ...D GLBL DMP(GNAME, HANDLE,NAM LEN)                                                   ; DISPLAYS  / WRITES  XML FILE
  1074    Q
  1075    ;
  1076    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1077    ; CHMPAY  (WORK FILE ) ^CHMPAYW ()
  1078    ; ^CHMPAY W = "74100 2.602^WORK  FLOW"
  1079    ; THIS FI LE UTILIZE S NO CROSS REFERENCES , SO FUNCT ION JUST O UTPUTS THE  ENTRIES
  1080    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1081    ;
  1082   PAYWRK(IDX ,HANDLE)
  1083    ; IDX           "I"  INDEX FOR  THE CLAIM  IN ^CHMPAY W()
  1084    ; HANDLE        FIEL  HANDLE FO R THE XML  FILE
  1085    N GNAME,F MSDOCID,PA YPTR,STATU S,CHECK,ST AT277,FILE NUM,BERRDT ,NAMLEN
  1086    S GNAME=" ^CHMPAYW(" _IDX_")"
  1087    S NAMLEN= $L(GNAME)- 1
  1088    D STARTEL E(GNAME,HA NDLE)                                           ; STAR T ELEMENT  FOR XML FI LE
  1089    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                           ; DI SPLAYS / W RITES XML  FILE
  1090    Q
  1091    ;  
  1092    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1093    ; EDI BUF FER   ^CHM EDI()
  1094    ; ^CHMEDI  = "741207 .01^835 ST ATUS" 
  1095    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1096    ;
  1097   EDIBUF(IDX ,HANDLE)
  1098    ; IDX           "I"  INDEX FOR  THE CLAIM  IN ^CHMPAY ()
  1099    ; HANDLE        FIEL  HANDLE FO R THE XML  FILE
  1100    N GNAME,F MSDOCID,PA YPTR,STATU S,CHECK,ST AT277,FILE NUM,BERRDT ,NAMLEN
  1101    S GNAME=" ^CHMEDI("_ IDX_")"
  1102    S NAMLEN= $L(GNAME)- 1
  1103    D STARTEL E(GNAME,HA NDLE)                                           ; STAR T ELEMENT  FOR XML FI LE
  1104    D GLBLDMP (GNAME,HAN DLE,NAMLEN )                           ; DI SPLAYS / W RITES XML  FILE
  1105    S GNAME=" ^CHMEDI("
  1106    S NAMLEN= $L($P(GNAM E,"(",1))
  1107    S FMSDOCI D=$P(^CHME DI(IDX,0), "^",1)             ;  PREP FOR " B" XREF
  1108    I FMSDOCI D'=""  D
  1109    .I $D(^CH MEDI("B",F MSDOCID))  D
  1110    ..S GNAME ="^CHMEDI( ""B"","""_ FMSDOCID_" "")"    ;  FMS DOC ID / RECONCIL IATION NUM BER
  1111    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)
  1112    S PAYPTR= $P(^CHMEDI (IDX,1,1,0 ),"^",1)           ;  PREP FOR " B" XREF
  1113    I PAYPTR' =""  D
  1114    .I $D(^CH MEDI("C",P AYPTR)) D
  1115    ..S GNAME ="^CHMEDI( ""C"","_PA YPTR_")"           ;  ^CHMPAY PO INTER(S)
  1116    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)
  1117    S STATUS= $P(^CHMEDI (IDX,0),"^ ",2)                        ; ST ATUS XREF
  1118    I STATUS' =""  D
  1119    .I $D(^CH MEDI("D",S TATUS,IDX) )  D                        ; VE RIFY THERE  IS A STAT US XREF
  1120    ..S GNAME ="^CHMEDI( ""D"","_ST ATUS_","_I DX_")"  ;  SET THE ST ATUS XREF    
  1121    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)
  1122    S CHECK=$ P(^CHMEDI( IDX,0),"^" ,3)                         ; CH ECK NUMBER  XREF
  1123    I CHECK'= ""  D
  1124    .I $D(^CH MEDI("E",C HECK)) D
  1125    ..S GNAME ="^CHMEDI( ""E"","_CH ECK_")"            
  1126    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)                                                                                                                                                                                                                                                                                        
  1127    S STAT277 =$P(^CHMED I(IDX,1,1, 0),"^",2)          ;  277 STATUS  XREF
  1128    I STAT277 '=""  D
  1129    .I $D(^CH MEDI("F",S TAT277,IDX )) D
  1130    ..S GNAME ="^CHMEDI( ""F"","_ST AT277_","_ IDX_")"          
  1131    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)
  1132    S FILENUM =$P(^CHMED I(IDX,0)," ^",6)                       ; CH ECK NUMBER  XREF
  1133    I FILENUM '=""  D
  1134    .I $D(^CH MEDI("G",F ILENUM)) D
  1135    ..S GNAME ="^CHMEDI( ""G"","_FI LENUM_")"          
  1136    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)
  1137    S BERRDT= $P(^CHMEDI (IDX,0),"^ ",7)                        ; BA LANCE ERRO R DATE XRE F
  1138    I BERRDT' =""  D
  1139    .I $D(^CH MEDI("H",B ERRDT)) D
  1140    ..S GNAME ="^CHMEDI( ""H"","_BE RRDT_")"           
  1141    ..D GLBLD MP(GNAME,H ANDLE,NAML EN)
  1142    Q
  1143    ;
  1144    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  1145    ;******** ********** ********** ********** ********** ********** ********** ***
  1146    ; THE FIL LOWING FUN CTIONS ARE  GENERIC,  I.E. THEY  PROVIDE CA PABILITIES
  1147    ; THAT AR E NOT UNIQ UELY TAILO RED TO GEN ERATING TH E XML FILE  FOR THE
  1148    ; CLAIM B UFFERS.
  1149    ;******** ********** ********** ********** ********** ********** ********** ***
  1150    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  1151    ;
  1152    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1153    ; $$GETPD ITYP(PDI)  RETURNS A  TEXT DESCR IPTION OF  THE CLAIM  TYPE 
  1154    ; (CHAMPV A/SXC/MEDC OB, ETC.)
  1155    ; W $$GET PDITYP(201 3225910387 83)  91: X 12 (MED) E DI
  1156    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1157    ;
  1158   GETPDITYP( PDI)
  1159    ; PDI           PDI  TO REPORT  CLAIM TYPE
  1160    N CTYPE
  1161    S CTYPE=$ E(PDI,8,9)
  1162    Q:CTYPE=" 00" "00: U NASSIGNED"
  1163    Q:CTYPE=" 02" "02: C HK REISSUE "
  1164    Q:CTYPE=" 03" "03: O CR (PAPER) "
  1165    Q:CTYPE=" 04" "04: C ITI"
  1166    Q:CTYPE=" 05" "05: P  RICO"
  1167    Q:CTYPE=" 06" "06: R E-OPEN"
  1168    Q:CTYPE=" 07" "07: W ALK-THRU"
  1169    Q:CTYPE=" 08" "08: C VAF"
  1170    Q:CTYPE=" 09" "09: P  GULF"
  1171    Q:CTYPE=" 10" "10: F MP"
  1172    Q:CTYPE=" 91" "91: M EDCOB EDI"
  1173    Q:CTYPE=" 92" "92: S B EDI"
  1174    Q:CTYPE=" 93" "93: C WVV EDI"
  1175    Q:CTYPE=" 98" "98: C MOP RXT"
  1176    Q:CTYPE=" 99" "99: R X EDI"
  1177    Q "OTHER  (PAPER/OCR )"
  1178    ;
  1179    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1180    ; PAYI2TY P() USES T HE ^CHMPAY (PAYI,"ZEM C") XREF T O RETRIEVE  CLAIM TYP E (ENV/MED COB/SXC/et c.)
  1181    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1182    ;
  1183   PAYI2TYP(P AYI)
  1184    ; PAYI          "I"  INDEX FOR  THE ^CHMPA Y FILE
  1185    N CLMTYP, CHTPID                  ; VARIAB LES TO RET RIEVE THE  CLAIM TYPE  FROM ^CHM PAY(PAYI," ZEMC" XREF
  1186    S CLMTYP= "NO ZEMC" 
  1187    Q:'$D(^CH MPAY(PAYI, "ZEMC")) C LMTYP
  1188    S CHTPID= 0,CHTPID=$ O(^CHMPAY( PAYI,"ZEMC ",CHTPID))
  1189    Q:CHTPID= "" CLMTYP
  1190    S:CHTPID= "SXC" CLMT YP="SXC PH ARMACY"
  1191    S:CHTPID= "ENV" CLMT YP="EMDEON  X12"
  1192    S:CHTPID= "MEDCOB" C LMTYP="MED ICARE CROS SOVER"
  1193    Q CLMTYP                                                             ; RETU RN THE "LO NG" VERSIO N OF THE C LAIM TYPE
  1194    ;
  1195    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  1196    ; CONVERT  THE YYYYM MDD DATE S TRING TO M M-DD-YYYY  FORMAT
  1197    ; W $$DTC VRT(201403 08) ->  03 -08-2014
  1198    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  1199    ;
  1200   DTCVRT(DAT E)
  1201    N EXTDATE
  1202    S EXTDATE =$E(DATE,5 ,6)_"-"_$E (DATE,7,8) _"-"_$E(DA TE,1,4)
  1203    Q EXTDATE       
  1204    ;
  1205    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;
  1206    ;******** ********** ********** ********** ********** ********** ********** *****
  1207    ; THE FOL LOWING FUN CTIONS ARE  TESTING F UNCTIONS U SED TO PER FORM OR VE RIFY
  1208    ; UNIT TE STING.
  1209    ;******** ********** ********** ********** ********** ********** ********** *****
  1210    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;
  1211    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;
  1212    ; NODEDUM P(NODE) US ES THE $QU ERY TO DIS PLAY POPUL ATED SUBNO DES TO THE  
  1213    ; SPECIFI ED NODE.
  1214    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;
  1215    ;
  1216   NODEDUMP(N ODE)
  1217    ; NODE          THE  STARTING N ODE FOR TH E DISPLAY
  1218    N REF,IEN ,NIEN,EXIT
  1219    S IEN=$$G ETIEN(NODE )                                                                         ;  GET THE IE N INDEX FR OM THE GLO BAL
  1220    S REF=NOD E,EXIT=0
  1221    F  Q:EXIT   S REF=$Q (@REF)  D                                                         ; JUST DIS PLAY THE S PECIFIED N ODE SUBNOD ES
  1222    .I $$ENDO FNODE(IEN, REF) D  Q
  1223    ..S EXIT= 1
  1224    .U 0 W !, REF,"= ",@ REF
  1225    Q
  1226    
  1227    
  1228    
  1229    
  1230    
  1231    
  1232    
  1233    
  1234    
  1235    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1236    ; GETIDX  EXTRACTS T HE NODE IN DEX FROM T HE GNAME V ARIABLE
  1237    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1238    ;
  1239   GETIDX(GNA ME)
  1240    ; GNAME                                                                                                          ; GLOB AL NAME AN D NODE NOD E INDEX CO MBINATION
  1241    N SIDX,EI DX,IDX                                                                                        ; ST ART/END PO INTERS FOR  THE INDEX  VALUE 
  1242    S SIDX=$L ($P(GNAME, "(",1))+2, EIDX=$L(GN AME)-1
  1243    S IDX=$E( GNAME,SIDX ,EIDX)       
  1244    U 0 W:VER BOSE !,"GE TIDX: IDX=  ",IDX
  1245    Q IDX                                                                                                            ; RETU RN THE IND EX VALUE
  1246    ;
  1247    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1248    ; ISXREF( ) BOOLEAN  TEST FOR T HE GNAME B EING A CRO SS-REFEREN CE
  1249    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1250    ;
  1251   NOTXREF(GN AME)
  1252    ; GNAME                                                                                                          ; GLOB AL NAME AN D NODE NOD E INDEX CO MBINATION
  1253    N SIDX,EI DX,IDX                                                                                        ; ST ART/END PO INTERS FOR  THE INDEX  VALUE 
  1254    S SIDX=$L ($P(GNAME, "(",1))+2, EIDX=$L($P (GNAME,"," ,1))-1
  1255    S IDX=$E( GNAME,SIDX ,EIDX)
  1256    Q IDX?1N. N                                                                                                      ; RETU RN TRUE IF  IDX VALUE  IS NUMERI C
  1257    ;      
  1258    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  1259    ; CHKMULT () IS A BO OLEAN CHEC K ON THE P ROVIDED NO DE TO DETE RMINE
  1260    ; IF THE  NODE IS A  "MULTIPLE"  MARKER
  1261    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  1262    ;
  1263   CHKMULT(NO DE,SUB)
  1264    ; NODE          THE  GLOBAL NOD E TO BE CH ECKED
  1265    N DVAL,FI LENUM,MFIL ENUM,RETUR N
  1266    S RETURN= 0                                                                            ; DEFAULT  RETURN IS  NON-MULTIP LE
  1267    S DVAL=$D (@NODE)                                                             ; CHECK  TO SEE IF  THE NODE I S POPULATE D
  1268    U 0 W:VER BOSE !,?5, "CHKMULT:   $D(@NODE) = ",DVAL
  1269    I DVAL#10   D                                                                 ; IF THE  NODE CONT AINS DATA
  1270    .S FILENU M=$$GETFNU M(NODE)                                         ; GET  THE BASE F ILE NUMBER  FOR THE G LOBAL 
  1271    .S MFILEN UM=$P(@NOD E,"^",2)                               ; GE T THE FILE  NUMBER FR OM THE NOD E
  1272    .S:MFILEN UM[FILENUM  RETURN=MF ILENUM             ;  IF THE NOD E CONTAINS  EXTENDED  FILE NUMBE R
  1273    .U 0 W:VE RBOSE !,?5 ,"CHKMULT:   FILENUM=  ",FILENUM ,"  MFILEN UM= ",MFIL ENUM,"  TS T= ",MFILE NUM[FILENU M
  1274    Q RETURN                                                                               ; RETURN T HE "MULTIP LE" FILE N UMBER
  1275    ;
  1276    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  1277    ; SUBTREE () RETRIEV ES THE SUC CESSIVE NO DES FOR TH E SUBTREE  DEFINED BY  "NODE"
  1278    ; FOR "MU LTIPLE" NO DES
  1279    ; EXAMPLE  CALL:  D  SUBTREE("C HMXCLF(810 97092,70)" )
  1280    ; THE SUB TREE WILL  RETURN THE  NEXT NODE  IN THE SU BTREE FOR  THE PROVID ED NODE
  1281    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  1282    ;
  1283   SUBTREE(GN ODE,SUB) ;  RETURN TH E NEXT SUB TREES OF T HE PROVIDE D GLOBAL @  THE "I" I NDEX
  1284    ; GNODE         NAME  OF THE DE SIRED GLOB AL (FILENA ME AND THE  "I" INDEX : "^CHMPAY (12345678) "
  1285    ; SUB           THE  CURRENT SU BSCRIPT
  1286    N DATA,SU B1,SUBLEN, XREF,RNAME ,FILENUM,E XIT,MULT
  1287    S XREF=0, RNAME="",E XIT=0
  1288    U 0 W:VER BOSE !,?10 ,"SUBTREE  ENTRY: NOD E= ",NODE, "  SUBSCRI PT= ",SUB
  1289    S MULT=$$ CHKMULT(NO DE)
  1290    U 0 W !,? 10,"SUBTRE E:  CHECK  NODE: ",NO DE," MULTI PLE = **** *",$S(MULT =1:"TRUE", 1:"FALSE") ,"*****"
  1291    S SUBLEN= $L(SUB)
  1292    F  Q:EXIT   D
  1293    .S SUB1=$ O(@GNODE)
  1294    .I (MULT) !((SUB1'=" ")&(SUB1'? 1A)) D 
  1295    ..U 0 W:V ERBOSE !,? 10,"SUBTRE E:  SUB1=$ O(@GNODE)=  ",SUB1 
  1296    ..S GNODE =($E(GNODE ,1,$L(GNOD E)-(SUBLEN +1))_SUB1_ ")") ; CRE ATE THE NE XT NODE AD DRESS
  1297    ..U 0 W:V ERBOSE !,? 10,"SUBTRE E:  $O(@GN ODE) UPDAT ED NODE= " ,GNODE,"   $D(@GNODE) = ",$D(@GN ODE)
  1298    ..S EXIT= 1
  1299    .E  D
  1300    ..S SUB=" "
  1301    ..S SUB=$ O(@GNODE@( SUB))                                                                     ;  GET THE NE XT SUBSCRI PT VALUE
  1302    ..U 0 W:V ERBOSE !,? 10,"SUBTRE E: $O(@GNO DE@(SUB) S UB= ",SUB
  1303    ..I (SUB' ="") D                                                                                                 ; &(SU B'?1A)
  1304    ...I GNOD E?.E1")" S  GNODE=($E (GNODE,1,$ L(GNODE)-1 )_","_$S(S UB?1N.N:SU B,1:""""_S UB_"""")_" )") ; CREA TE THE NEX T NODE ADD RESS
  1305    ...E  S G NODE=(GNOD E_"("_$S(S UB?1N.N:SU B,1:""""_S UB_"""")_" )")
  1306    ..S EXIT= 1
  1307    ..U 0 W:V ERBOSE !,? 10,"SUBTRE E:  $O(@GN ODE@(SUB))  UPDATED N ODE= ",GNO DE,"  $D(@ GNODE)= ", $D(@GNODE)
  1308    Q GNODE
  1309    ;
  1310    ;
  1311   SUBTST()
  1312    N NODE,SU BS,XIT,SUB V,TMP,FILE NUM,MULTIP LE
  1313    S NODE="^ CHMXCLF(81 097092,70) ",SUBV="", XIT=0
  1314    F  Q:XIT   D
  1315    .U 0 W !, ?5,"SUBTST :  GET NEX T NODE FOL LOWING ",N ODE
  1316    .S NODE=$ $SUBTREEQ( NODE,SUBV)
  1317    .U 0 W !, ?5,"SUBTST :  ",?60," SUBTREE RE TURNED: ** ***  ",NOD E,"  ***** "
  1318    .S SUBS=$ L(NODE,","
  1319    .S TMP=$P (NODE,")", 1)
  1320    .S SUBV=$ P(TMP,",", SUBS)
  1321    .U 0 W !? 5,"SUBTST:  NEW SUBV=  ",SUBV
  1322    .R RCH
  1323    .S:(RCH=" Q")!(RCH=" q") XIT=1
  1324    Q
  1325    ;
  1326    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1327    ; SUBTREE Q(NODE)  U SES THE QU ERY COMMAN D TO RETRI EVE THE NE XT
  1328    ; SUBNODE  OF THE GL OBAL
  1329    ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1330    ;
  1331   SUBTREEQ(N ODE,SUB)
  1332    N NODE1
  1333    S NODE1=$ Q(@NODE)
  1334    Q NODE1