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