HDISVSFX ;CT/GRR ; 24 Jan 2005 10:28 AM
;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
FILE(HDISDOM,HDISFAC,HDISFLFN,HDISARRY) ;
N HDISQQ,HDISOUT,X,HDIST,HDISY,HDISMD,HDISPROD,HDISFILE,HDISFN,HDISDOMN,HDISSRC,HDERR
N HDISDA,HDISFIR,HDISTERM,HDISTSD,HDISSTAT,HDISTSDX,HDISVUID,HDISNST,HDISNTLF,HDISTP,Y
I HDISDOM=""!(HDISFAC="")!(HDISFLFN="")!(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 X=$$GETFAC^HDISVF07(HDISFAC,,.HDISSRC)
S HDISMD=$P($G(^HDISF(7118.21,HDISFAC,0)),"^",2)
S HDISPROD=$P($G(^HDISF(7118.21,HDISFAC,0)),"^",3)
S HDISFILE=$P($G(^HDIS(7115.6,HDISFLFN,0)),"^",2)
S HDISFN=$P($G(^HDIS(7115.6,HDISFLFN,0)),"^",4)
;
;Set XML header in output array
S @HDISARRY@(1)="<?xml version=""1.0"" encoding=""utf-8"" ?>"
;S @HDISARRY@(1)=$$XMLHDR^XOBVLIB()
S @HDISARRY@(2)="<"_$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
;
;
;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)
;
;Loop through all file entries, create xml entry for each
N HDISDA S HDISDA=0 F S HDISDA=$O(^HDISF(7118.22,"AC",HDISFAC,HDISFLFN,HDISDA)) Q:HDISDA'>0 D
.S HDISY=^HDISF(7118.22,HDISDA,0)
.S HDISFIR=$P(HDISY,"^",3),HDISTP=$P(HDISY,"^",4)
.S HDISTERM=$P($G(^HDISV(7118.11,HDISTP,0)),"^")
.S HDISNTLF=""
.S HDISNST=$$GETNTLF^HDISVF04(HDISTP,.HDISNTLF)
.S HDISTSDX=""
.S HDISVUID=$P($G(^HDISV(7118.11,HDISTP,"VUID")),"^")
.S Z(60)=HDISTERM
.S Z(70)=HDISVUID
.S Z(80)=HDISNTLF
.S Z(100)=HDISFIR
.D XMLOUT^HDISXML(HDIST,"50,60,70,80,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[HHDISVSFX 2529 printed Dec 13, 2024@01:57:04 Page 2
HDISVSFX ;CT/GRR ; 24 Jan 2005 10:28 AM
+1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
FILE(HDISDOM,HDISFAC,HDISFLFN,HDISARRY) ;
+1 NEW HDISQQ,HDISOUT,X,HDIST,HDISY,HDISMD,HDISPROD,HDISFILE,HDISFN,HDISDOMN,HDISSRC,HDERR
+2 NEW HDISDA,HDISFIR,HDISTERM,HDISTSD,HDISSTAT,HDISTSDX,HDISVUID,HDISNST,HDISNTLF,HDISTP,Y
+3 IF HDISDOM=""!(HDISFAC="")!(HDISFLFN="")!(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 X=$$GETFAC^HDISVF07(HDISFAC,,.HDISSRC)
+15 SET HDISMD=$PIECE($GET(^HDISF(7118.21,HDISFAC,0)),"^",2)
+16 SET HDISPROD=$PIECE($GET(^HDISF(7118.21,HDISFAC,0)),"^",3)
+17 SET HDISFILE=$PIECE($GET(^HDIS(7115.6,HDISFLFN,0)),"^",2)
+18 SET HDISFN=$PIECE($GET(^HDIS(7115.6,HDISFLFN,0)),"^",4)
+19 ;
+20 ;Set XML header in output array
+21 SET @HDISARRY@(1)="<?xml version=""1.0"" encoding=""utf-8"" ?>"
+22 ;S @HDISARRY@(1)=$$XMLHDR^XOBVLIB()
+23 SET @HDISARRY@(2)="<"_$PIECE(HDISY(0),"^",4)_" "_$GET(^HDIS(7115.3,HDIST,1))_">"
+24 ;
+25 ;Initialize Z array which will contain input data for XML routine
+26 NEW Z
KILL Z
DO ZINIT
+27 ;
+28 ;Store Domain Name, Facility Number, MailMan Domain, File, and Field Number
+29 ;in output array
+30 SET Z(10)=HDISDOMN
+31 SET Z(20)=HDISSRC
+32 SET Z(22)=HDISPROD
+33 SET Z(25)=HDISMD
+34 SET Z(40)=HDISFILE
+35 SET Z(45)=HDISFN
+36 ;
+37 ;
+38 ;Write out first 5 xml elements to output array
+39 ;
+40 DO XMLOUT^HDISXML(HDIST,"10,20,22,25,30,40,45,","Z",HDISARRY,.HDERR)
+41 ;
+42 ;Get the node and piece position of term to be standardized
+43 ;(In most cases it is the .01 field)
+44 ;
+45 ;Loop through all file entries, create xml entry for each
+46 NEW HDISDA
SET HDISDA=0
FOR
SET HDISDA=$ORDER(^HDISF(7118.22,"AC",HDISFAC,HDISFLFN,HDISDA))
if HDISDA'>0
QUIT
Begin DoDot:1
+47 SET HDISY=^HDISF(7118.22,HDISDA,0)
+48 SET HDISFIR=$PIECE(HDISY,"^",3)
SET HDISTP=$PIECE(HDISY,"^",4)
+49 SET HDISTERM=$PIECE($GET(^HDISV(7118.11,HDISTP,0)),"^")
+50 SET HDISNTLF=""
+51 SET HDISNST=$$GETNTLF^HDISVF04(HDISTP,.HDISNTLF)
+52 SET HDISTSDX=""
+53 SET HDISVUID=$PIECE($GET(^HDISV(7118.11,HDISTP,"VUID")),"^")
+54 SET Z(60)=HDISTERM
+55 SET Z(70)=HDISVUID
+56 SET Z(80)=HDISNTLF
+57 SET Z(100)=HDISFIR
+58 DO XMLOUT^HDISXML(HDIST,"50,60,70,80,100,50/,","Z",HDISARRY,.HDERR)
End DoDot:1
+59 ;
+60 ;Set final XML closing elements
+61 DO XMLOUT^HDISXML(HDIST,"30/,5/,","Z",HDISARRY,.HDERR)
+62 SET HDISOUT=1
+63 ;
QUIT QUIT HDISOUT
+1 ;
+2 ;
ZINIT ;
+1 SET Z(22)=""
FOR Z=5:5:100
SET Z(Z)=""
+2 QUIT
+3 ;
