HDISVCMR ;CT/GRR Data Standardization ; 06 Oct 2005 2:12 PM
;;1.0;HEALTH DATA & INFORMATICS;**1,2,18**;Feb 22, 2005;Build 4
;
EN(HDISDOM,HDISFILE) ;
;Input parameter:
; HDISDOM - IEN to the HDIS Domain file (Required)
; HDISFILE - Specific file # to be seeded (if not all domain files) (Optional)
N HDISNM,HDISDT,HDERR,HDISFILS,HDISOK,HDISFLIS,HDISDA,HDISOUT,HDISSDT
S HDISFLIS=""
S HDISFN=.01
S HDISNM=$G(^XMB("NETNAME"))
S HDISDT=$$NOW^XLFDT(),HDISSDT=$$FMTXML^HDISVU01(HDISDT)
I $G(HDISDOM)="" S HDISMESS="Required parameter (Domain) empty, File: "_HDISFILE_", Field: "_HDISFN D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) Q
I '$D(^HDIS(7115.1,HDISDOM)) S HDISMESS="Domain ("_HDISDOM_") does not exist. File: "_HDISFILE_", Field: "_HDISFN D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) Q
I $$GETVFAIL^HDISVF02() S HDISMESS="VUID DS processer called but is in failsafe mode" D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) Q
S HDISOK=$$GETFILS^HDISVF09(HDISDOM,0,.HDISFILS)
I 'HDISOK S HDISMESS="No files are pending VUID processing in Domain "_$P(^HDIS(7115.1,HDISDOM,0),"^",1) D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) Q ;modified 5/16/05 p-1
I $G(HDISFILE)]"" D Q
.I $D(HDISFILS(HDISFILE)) D CREATE(HDISDOM,HDISFILE,HDISFN) I 1
.E D ERR^HDISVF09(HDISNM,HDISDT,"File: "_HDISFILE_" is not awaiting processing")
S HDISDA=0 F S HDISDA=$O(HDISFILS(HDISDA)) Q:HDISDA'>0 D CREATE(HDISDOM,HDISDA,.01)
Q
;
CREATE(HDISDOM,HDISFILE,HDISFN) ;
N HDISARRY,HDISMESS
;Update local status
S HDISOUT=$$STATUPD^HDISVCUT(HDISFILE,HDISFN,1)
S HDISARRY=$NA(^TMP("HDIS",$J)) ;Pavel fix the error if this variable is not defined.
;I 'HDISOUT S HDISMESS=$P(HDISOUT,"^",2) D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) G CR8OUT
I 'HDISOUT S HDISMESS=$P(HDISOUT,"^",2) D G CR8OUT
. D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
. Q:'$D(XPD)
. D BMES^XPDUTL("Local Status update of file: "_HDISFILE_" Failed - INSTALLATION ABORTED Reason: "_HDISMESS)
. S XPDABORT=1
;
;Create XML doc containing facility data
;S HDISARRY=$NA(^TMP("HDIS",$J)) ;Pavel fix the error if this variable is not defined.
S HDISOUT=$$FILE^HDISVCFX(HDISDOM,HDISFILE,HDISFN,HDISARRY)
I 'HDISOUT S HDISMESS=$P(HDISOUT,"^",2) D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) G CR8OUT
;
; Send XML doc to Central Server
S HDISOUT=$$SNDXML^HDISVM02(HDISARRY,1,"") ;removed last parameter 8/10/05 p-2
I 'HDISOUT S HDISMESS=$P(HDISOUT,"^",2) D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) G CR8OUT
;
;Update local status file
S HDISOUT=$$STATUPD^HDISVCUT(HDISFILE,HDISFN,2)
I 'HDISOUT S HDISMESS=$P(HDISOUT,"^",2) D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) G CR8OUT
;
CR8OUT K @HDISARRY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVCMR 2685 printed Dec 13, 2024@01:56:43 Page 2
HDISVCMR ;CT/GRR Data Standardization ; 06 Oct 2005 2:12 PM
+1 ;;1.0;HEALTH DATA & INFORMATICS;**1,2,18**;Feb 22, 2005;Build 4
+2 ;
EN(HDISDOM,HDISFILE) ;
+1 ;Input parameter:
+2 ; HDISDOM - IEN to the HDIS Domain file (Required)
+3 ; HDISFILE - Specific file # to be seeded (if not all domain files) (Optional)
+4 NEW HDISNM,HDISDT,HDERR,HDISFILS,HDISOK,HDISFLIS,HDISDA,HDISOUT,HDISSDT
+5 SET HDISFLIS=""
+6 SET HDISFN=.01
+7 SET HDISNM=$GET(^XMB("NETNAME"))
+8 SET HDISDT=$$NOW^XLFDT()
SET HDISSDT=$$FMTXML^HDISVU01(HDISDT)
+9 IF $GET(HDISDOM)=""
SET HDISMESS="Required parameter (Domain) empty, File: "_HDISFILE_", Field: "_HDISFN
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
QUIT
+10 IF '$DATA(^HDIS(7115.1,HDISDOM))
SET HDISMESS="Domain ("_HDISDOM_") does not exist. File: "_HDISFILE_", Field: "_HDISFN
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
QUIT
+11 IF $$GETVFAIL^HDISVF02()
SET HDISMESS="VUID DS processer called but is in failsafe mode"
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
QUIT
+12 SET HDISOK=$$GETFILS^HDISVF09(HDISDOM,0,.HDISFILS)
+13 ;modified 5/16/05 p-1
IF 'HDISOK
SET HDISMESS="No files are pending VUID processing in Domain "_$PIECE(^HDIS(7115.1,HDISDOM,0),"^",1)
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
QUIT
+14 IF $GET(HDISFILE)]""
Begin DoDot:1
+15 IF $DATA(HDISFILS(HDISFILE))
DO CREATE(HDISDOM,HDISFILE,HDISFN)
IF 1
+16 IF '$TEST
DO ERR^HDISVF09(HDISNM,HDISDT,"File: "_HDISFILE_" is not awaiting processing")
End DoDot:1
QUIT
+17 SET HDISDA=0
FOR
SET HDISDA=$ORDER(HDISFILS(HDISDA))
if HDISDA'>0
QUIT
DO CREATE(HDISDOM,HDISDA,.01)
+18 QUIT
+19 ;
CREATE(HDISDOM,HDISFILE,HDISFN) ;
+1 NEW HDISARRY,HDISMESS
+2 ;Update local status
+3 SET HDISOUT=$$STATUPD^HDISVCUT(HDISFILE,HDISFN,1)
+4 ;Pavel fix the error if this variable is not defined.
SET HDISARRY=$NAME(^TMP("HDIS",$JOB))
+5 ;I 'HDISOUT S HDISMESS=$P(HDISOUT,"^",2) D ERR^HDISVF09(HDISNM,HDISDT,HDISMESS) G CR8OUT
+6 IF 'HDISOUT
SET HDISMESS=$PIECE(HDISOUT,"^",2)
Begin DoDot:1
+7 DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
+8 if '$DATA(XPD)
QUIT
+9 DO BMES^XPDUTL("Local Status update of file: "_HDISFILE_" Failed - INSTALLATION ABORTED Reason: "_HDISMESS)
+10 SET XPDABORT=1
End DoDot:1
GOTO CR8OUT
+11 ;
+12 ;Create XML doc containing facility data
+13 ;S HDISARRY=$NA(^TMP("HDIS",$J)) ;Pavel fix the error if this variable is not defined.
+14 SET HDISOUT=$$FILE^HDISVCFX(HDISDOM,HDISFILE,HDISFN,HDISARRY)
+15 IF 'HDISOUT
SET HDISMESS=$PIECE(HDISOUT,"^",2)
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
GOTO CR8OUT
+16 ;
+17 ; Send XML doc to Central Server
+18 ;removed last parameter 8/10/05 p-2
SET HDISOUT=$$SNDXML^HDISVM02(HDISARRY,1,"")
+19 IF 'HDISOUT
SET HDISMESS=$PIECE(HDISOUT,"^",2)
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
GOTO CR8OUT
+20 ;
+21 ;Update local status file
+22 SET HDISOUT=$$STATUPD^HDISVCUT(HDISFILE,HDISFN,2)
+23 IF 'HDISOUT
SET HDISMESS=$PIECE(HDISOUT,"^",2)
DO ERR^HDISVF09(HDISNM,HDISDT,HDISMESS)
GOTO CR8OUT
+24 ;
CR8OUT KILL @HDISARRY
+1 QUIT
