- 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 Feb 18, 2025@23:23:05 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