| [613] | 1 | HDISVCFX ;CT/GRR ; 24 Jan 2005  10:26 AM
 | 
|---|
 | 2 |  ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
 | 
|---|
 | 3 | FILE(HDISDOM,HDISFILE,HDISFN,HDISARRY) ;
 | 
|---|
 | 4 |  N HDISQQ,HDISGL,HDISNODE,HDISPIC,Y
 | 
|---|
 | 5 |  N HDISOUT
 | 
|---|
 | 6 |  I HDISDOM=""!(HDISFILE="")!(HDISFN="")!(HDISARRY="") S HDISOUT=0_"^Parameter Missing" G QUIT
 | 
|---|
 | 7 |  K @HDISARRY
 | 
|---|
 | 8 |  ;Lookup VUID XML template to build XML document
 | 
|---|
 | 9 |  S DIC=7115.3,DIC(0)="Z",X="VUID" D ^DIC K DIC
 | 
|---|
 | 10 |  I Y<0 S HDISOUT=0_"^VUID Template Missing" G QUIT
 | 
|---|
 | 11 |  S HDIST=+Y,HDISY=Y,HDISY(0)=Y(0)
 | 
|---|
 | 12 |  ;
 | 
|---|
 | 13 |  ;Get Domain name
 | 
|---|
 | 14 |  S HDISDOMN=$P($G(^HDIS(7115.1,HDISDOM,0)),"^")
 | 
|---|
 | 15 |  ;
 | 
|---|
 | 16 |  ;Get Facility Number, MailMan Parameters, and mailMan Domain name
 | 
|---|
 | 17 |  S HDISSRC=$P($$SITE^VASITE(),"^",3)
 | 
|---|
 | 18 |  S HDISMD=$G(^XMB("NETNAME"))
 | 
|---|
 | 19 |  S HDISPROD=$$PROD^XUPROD()
 | 
|---|
 | 20 |  ;
 | 
|---|
 | 21 |  ;Set XML header in output array
 | 
|---|
 | 22 |  S @HDISARRY@(1)="<?xml version=""1.0"" encoding=""utf-8"" ?>"
 | 
|---|
 | 23 |  ;S @HDISARRY@(1)=$$XMLHDR^XOBVLIB()
 | 
|---|
 | 24 |  S @HDISARRY@(1)="<"_$P(HDISY(0),"^",4)_" "_$G(^HDIS(7115.3,HDIST,1))_">"
 | 
|---|
 | 25 |  ;
 | 
|---|
 | 26 |  ;Initialize Z array which will contain input data for XML routine
 | 
|---|
 | 27 |  N Z K Z D ZINIT
 | 
|---|
 | 28 |  ;
 | 
|---|
 | 29 |  ;Store Domain Name, Facility Number, MailMan Domain, File, and Field Number
 | 
|---|
 | 30 |  ;in output array
 | 
|---|
 | 31 |  S Z(10)=HDISDOMN
 | 
|---|
 | 32 |  S Z(20)=HDISSRC
 | 
|---|
 | 33 |  S Z(22)=HDISPROD
 | 
|---|
 | 34 |  S Z(25)=HDISMD
 | 
|---|
 | 35 |  S Z(40)=HDISFILE
 | 
|---|
 | 36 |  S Z(45)=HDISFN
 | 
|---|
 | 37 |  ;
 | 
|---|
 | 38 |  ;Get global root of file
 | 
|---|
 | 39 |  S HDISGL=$$ROOT^DILFD(HDISFILE,"",1) D CLEAN^DILF
 | 
|---|
 | 40 |  ;
 | 
|---|
 | 41 |  ;Write out first 5 xml elements to output array
 | 
|---|
 | 42 |  D XMLOUT^HDISXML(HDIST,"10,20,22,25,30,40,45,","Z",HDISARRY,.HDERR)
 | 
|---|
 | 43 |  ;
 | 
|---|
 | 44 |  ;Get the node and piece position of term to be standardized
 | 
|---|
 | 45 |  ;(In most cases it is the .01 field)
 | 
|---|
 | 46 |  S HDGL=$$GET1^DID(HDISFILE,HDISFN,"","GLOBAL SUBSCRIPT LOCATION")
 | 
|---|
 | 47 |  S HDISNODE=$P(HDGL,";",1)
 | 
|---|
 | 48 |  S HDISPIC=$P(HDGL,";",2)
 | 
|---|
 | 49 |  ;
 | 
|---|
 | 50 |  ;Loop through all file entries, create xml entry for each
 | 
|---|
 | 51 |  N HDISDA S HDISDA=0 F  S HDISDA=$O(@HDISGL@(HDISDA)) Q:HDISDA'>0  I $D(@HDISGL@(HDISDA,0)) D
 | 
|---|
 | 52 |  .S Z(60)=$P(@HDISGL@(HDISDA,HDISNODE),"^",HDISPIC)
 | 
|---|
 | 53 |  .S Z(70)=""
 | 
|---|
 | 54 |  .S Z(80)=""
 | 
|---|
 | 55 |  .S Z(100)=HDISDA_","
 | 
|---|
 | 56 |  .D XMLOUT^HDISXML(HDIST,"50,60,70,100,50/,","Z",HDISARRY,.HDERR)
 | 
|---|
 | 57 |  ;
 | 
|---|
 | 58 |  ;Set final XML closing elements
 | 
|---|
 | 59 |  D XMLOUT^HDISXML(HDIST,"30/,5/,","Z",HDISARRY,.HDERR)
 | 
|---|
 | 60 |  S HDISOUT=1
 | 
|---|
 | 61 |  ;
 | 
|---|
 | 62 | QUIT Q HDISOUT
 | 
|---|
 | 63 |  ;
 | 
|---|
 | 64 |  ;
 | 
|---|
 | 65 | ZINIT ;
 | 
|---|
 | 66 |  S Z(22)="" F Z=5:5:100 S Z(Z)=""
 | 
|---|
 | 67 |  Q
 | 
|---|
 | 68 |  ;
 | 
|---|