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