source: WorldVistAEHR/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVCFX.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1HDISVCFX ;CT/GRR ; 24 Jan 2005 10:26 AM
2 ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
3FILE(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 ;
62QUIT Q HDISOUT
63 ;
64 ;
65ZINIT ;
66 S Z(22)="" F Z=5:5:100 S Z(Z)=""
67 Q
68 ;
Note: See TracBrowser for help on using the repository browser.