HDISVCFX.m

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

 ;

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       ;