HDISVF09 ;ALB/RMO,ALB/GRR - 7115.1 File Utilities/API Cont.; 2/1/06@09:56:00
;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
;
;---- Begin HDIS Domain file (#7115.1) API(s) ----
;
FINDDOM(HDISDOM,HDISDFFS,HDISADDF,HDISDIEN,HDISERRM) ;Find or Add a New Domain Entry
; Input -- HDISDOM Domain Name
; HDISDFFS Domain File/Field Array (Optional)
; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
; Example: HDISDFFS(100.1)=""
; HDISADDF Add a New Entry Flag (Optional- Default 0)
; 1=Yes and 0=No
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISDIEN HDIS Domain file IEN
; If Failure:
; HDISERRM Error Message (Optional)
N HDISOKF
;Initialize output
S (HDISDIEN,HDISERRM)=""
;Check for missing variable, exit if not defined
I $G(HDISDOM)="" D G FINDDOMQ
. S HDISERRM="Unable to Find or Add Domain. Required Variable Missing."
;Check for existing Domain, return entry and exit if it exists
I $D(^HDIS(7115.1,"B",HDISDOM)) D G FINDDOMQ:$G(HDISDIEN)
. S HDISDIEN=$O(^HDIS(7115.1,"B",HDISDOM,0))
. S HDISOKF=1
;If flag set, Add a New Domain Entry
I $G(HDISADDF) S HDISOKF=$$ADDDOM(HDISDOM,.HDISDFFS,.HDISDIEN,.HDISERRM)
FINDDOMQ Q +$G(HDISOKF)
;
ADDDOM(HDISDOM,HDISDFFS,HDISDIEN,HDISERRM) ;Add a New Domain Entry
; Input -- HDISDOM Domain Name
; HDISDFFS Domain File/Field Array (Optional)
; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
; Example: HDISDFFS(100.1)=""
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISDIEN HDIS Domain file IEN
; If Failure:
; HDISERRM Error Message (Optional)
N HDISFDA,HDISIEN,HDISMSG,HDISOKF
;Initialize output
S (HDISDIEN,HDISERRM)=""
;Check for missing variable, exit if not defined
I $G(HDISDOM)="" D G ADDDOMQ
. S HDISERRM="Unable to Add Domain. Required Variable Missing."
;Check for existing Domain, return error and exit if it exists
I $D(^HDIS(7115.1,"B",HDISDOM)) D G ADDDOMQ
. S HDISERRM="Domain already exists."
;Set array for Domain Name
S HDISFDA(7115.1,"+1,",.01)=$G(HDISDOM)
D UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
;Check for error
I $D(HDISMSG("DIERR")) D
. S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
ELSE D
. S HDISDIEN=+$G(HDISIEN(1))
. S HDISOKF=1
D CLEAN^DILF
;If Domain File/Field Array is passed, Add Domain File/Fields
I $G(HDISDIEN)>0,$D(HDISDFFS) S HDISOKF=$$ADDDFFS(HDISDIEN,.HDISDFFS,.HDISERRM)
ADDDOMQ Q +$G(HDISOKF)
;
ADDDFFS(HDISDIEN,HDISDFFS,HDISERRM) ;Add Domain File/Fields
; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
; HDISDFFS Domain File/Field Array
; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
; Example: HDISDFFS(100.1)=""
; Output -- 1=Successful and 0=Failure
; If Failure:
; HDISERRM Error Message (Optional)
N HDISCNT,HDISFARY,HDISFDA,HDISFFNM,HDISFIEN,HDISFILN,HDISFLDN,HDISIEN,HDISMSG,HDISOKF
;Initialize output
S HDISERRM=""
;Check for missing variables, exit if not defined
I $G(HDISDIEN)'>0!('$D(HDISDFFS)) D G ADDDFFSQ
. S HDISERRM="Unable to Add Domain File/Fields. Required Variable Missing."
;Add a new File/Field Entry
S HDISFILN=0
F S HDISFILN=$O(HDISDFFS(HDISFILN)) Q:'HDISFILN D G ADDDFFSQ:HDISERRM'=""
. ;Set Field Number to default of .01, if not defined
. S HDISFLDN=$S($G(HDISDFFS(HDISFILN))>0:$G(HDISDFFS(HDISFILN)),1:.01)
. I $$ADDFFNM^HDISVF05(HDISFILN,HDISFLDN,.HDISFIEN,.HDISERRM) D Q:HDISERRM'=""
. . S HDISFARY(HDISFIEN)=""
. ELSE D
. . ;Set error message, if unable to add file/field
. . S HDISERRM="Unable to Add File/Field "_HDISFILN_"~"_HDISFLDN_"."
;
;Set array for File/Field
S HDISFIEN=0
S HDISCNT=1
F S HDISFIEN=$O(HDISFARY(HDISFIEN)) Q:'HDISFIEN I $D(^HDIS(7115.6,HDISFIEN,0)) S HDISFFNM=$P(^(0),"^",1) D
. S HDISCNT=HDISCNT+1
. S HDISFDA(7115.11,"+"_HDISCNT_","_HDISDIEN_",",.01)=HDISFFNM
D UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
;Check for error
I $D(HDISMSG("DIERR")) D
. S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
ELSE D
. S HDISOKF=1
ADDDFFSQ Q +$G(HDISOKF)
;
GETFILS(HDISDIEN,HDISCODE,HDISFILS) ;Get an Array of Files by Domain and Client Status Code
; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
; HDISCODE Client Status Code (Optional- Default 0=Not Started for Client)
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISFILS Array Subscripted by File # (i.e. HDISFILS(120.8)="")
N HDISFIEN,HDISFILN,HDISFLDN
;Initialize ouput
K HDISFILS
;Check for missing variable, exit if not defined
I $G(HDISDIEN)'>0 G GETFILSQ
;Set Status Code to default of 0=Not Started for Client, if needed
S HDISCODE=$S('$D(HDISCODE):0,1:HDISCODE)
;Check Status of File/Fields and build array
S HDISFIEN=0
F S HDISFIEN=$O(^HDIS(7115.1,HDISDIEN,"FILE","B",HDISFIEN)) Q:'HDISFIEN D
. I $$GETFF^HDISVF05(HDISFIEN,.HDISFILN,.HDISFLDN),$P($$GETSTAT^HDISVF01(HDISFILN,HDISFLDN),"^",1)=HDISCODE D
. . S HDISFILS(HDISFILN)=""
GETFILSQ Q +$S($D(HDISFILS):1,1:0)
;
GETIEN(HDISDOM,HDISDIEN) ;Get IEN for a Domain by Domain
; Input -- HDISDOM Domain Name
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISDIEN HDIS Domain file IEN
;Initialize ouput
S HDISDIEN=""
;Check for missing variable, exit if not defined
I $G(HDISDOM)="" G GETIENQ
;Check for entry by Domain
S HDISDIEN=$O(^HDIS(7115.1,"B",HDISDOM,0))
GETIENQ Q +$S($G(HDISDIEN)>0:1,1:0)
;
;---- End HDIS Domain file (#7115.1) API(s) ----
;
;Error processing utility
;
ERR(HDISP1,HDISP2,HDISP3) ;
;;Input: HDISP1 - Network Name (parameter 1 of bulletin)
;; HDISP2 - Date/Time (parameter 2 of bulletin)
;; HDISP3 - Error Message (parameter 3 of bulletin)
;;Output: None
;;
N HDISP,HDISTASK,NAME,ERRARR,HDISE
S HDISE="" S ERRARR="HDISE",HDISE(1)=""
S HDISP(1)=HDISP1
S Y=HDISP2 D DD^%DT S HDISP(2)=Y
S HDISP(3)=HDISP3
S NAME="HDIS ERRORS"
S HDISFLAG("FROM")="HDIS DS Client"
D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
I $G(XMERR) D
.;Error generating bulletin - log error text
.D ERR2XTMP^HDISVU01("HDI-XM","General error bulletin",$NA(^TMP("XMERR",$J)))
.K XMERR,^TMP("XMERR",$J)
Q
;
ERTBULL(HDISP1,HDISP2,HDISP3,HDISP4,HDISP5,HDISP6) ;
N ERRARR,HDISP,NAME,HDISFLAG,HDISTASK
S ERRARR=$NA(^TMP("HDIS ERRORS",$J)),^TMP("HDIS ERRORS",$J,1)=""
S HDISP(1)=HDISP1
S HDISP(2)=HDISP2
N Y S Y=HDISP3 D DD^%DT
S HDISP(3)=Y
S HDISP(4)=HDISP4
S HDISP(5)=HDISP5
S HDISP(6)=HDISP6
S NAME="HDIS NOTIFY ERT"
S HDISFLAG("FROM")="HDIS Data Standardization Server"
D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
I $G(XMERR) D
.;Error generating bulletin - log error text
.D ERR2XTMP^HDISVU01("HDI-XM","ERT bulletin",$NA(^TMP("XMERR",$J)))
.K XMERR,^TMP("XMERR",$J)
Q
;
MFSUP(HDISFILE,HDISERR,HDISFN) ; Update status to complete and send HDR Bulletin
;;Input: HDISFILE - File Number of file just updated (Required)
;; HDISERR - Error indicator from MFS (1 or 0) (Required)
;; HDISFN - Field number (Optional)
;;
;;Output: None
N HDISCODE,HDISARRY,HDISOUT,HDISNM,HDISMESS,FILE,HDISTASK,NAME,OOPS,SYSTYPE,TMP
S HDISCODE=$$GETSTAT^HDISVF01(HDISFILE)
S FILE=HDISFILE
Q:$P(HDISCODE,"^",1)'=4&($P(HDISCODE,"^",1)'=5)
S HDISARRY=$NA(^TMP("HDIS STATUS",$J))
I $G(HDISERR) S HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),"Error from MFS") S HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,5,$$NOW^XLFDT(),HDISARRY,"") D SETSTAT^HDISVF01(HDISFILE,.01,5,$$NOW^XLFDT()) Q
S HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,6,$$NOW^XLFDT(),HDISARRY,"")
I HDISOUT=0 S HDISMESS="Staus update to complete failed",HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS) Q
D SETSTAT^HDISVF01(HDISFILE,.01,6,$$NOW^XLFDT())
I HDISOUT=0 S HDISMESS="Staus update to complete failed",HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS) Q
;Notify HDR that triggers should be turned on
N FACPTR,FACNAME,FACNUM,DOMAIN,SYSTYP,FILENAME,HDISBDT
S OOPS=0
I '$$GETFAC^HDISVF07(,.FACPTR) S OOPS=1
I '$$GETDIP^HDISVF07(,.DOMAIN) S OOPS=1
I '$$GETTYPE^HDISVF07(,,.SYSTYPE) S OOPS=1
I OOPS=1 D
.S FACPTR=$$FACPTR^HDISVF01()
.S DOMAIN=$G(^XMB("NETNAME"))
.S SYSTYPE=$$PROD^XUPROD()
.S SYSTYPE=$S(SYSTYPE:"PRODUCTION",1:"TEST")
S TMP=$$NS^XUAF4(FACPTR)
S FACNAME=$P(TMP,"^",1)
S FACNUM=$P(TMP,"^",2)
I (FACNAME="")!(FACNUM="") D
.S TMP=$$SITE^VASITE()
.S FACNAME=$P(TMP,"^",2)
.S FACNUM=$P(TMP,"^",3)
S FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_DOMAIN
S FILENAME=$$GET1^DID(FILE,,,"NAME")
S FILENAME=FILENAME_" (#"_FILE_")"
S HDISBDT=$$NOW^XLFDT()
S ERRARR=$NA(^TMP("HDIS ERRORS",$J)),^TMP("HDIS ERRORS",$J,1)=""
N HDISP
S HDISP(1)=FACNAME
S HDISP(2)=FILENAME
N Y S Y=$$NOW^XLFDT() D DD^%DT
S HDISP(3)=Y
S HDISP(4)=SYSTYPE
S HDISP(5)=FACNUM
S HDISP(6)=FILE
S NAME="HDIS NOTIFY HDR"
S HDISFLAG("FROM")="HDIS Data Standardization Server"
D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
I $G(XMERR) D
.;Error generating bulletin - log error text
.D ERR2XTMP^HDISVU01("HDI-XM","HDR bulletin",$NA(^TMP("XMERR",$J)))
.K XMERR,^TMP("XMERR",$J)
Q
HDISVF09 ;ALB/RMO,ALB/GRR - 7115.1 File Utilities/API Cont.; 2/1/06@09:56:00
+1 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
+2 ;
+3 ;---- Begin HDIS Domain file (#7115.1) API(s) ----
+4 ;
FINDDOM(HDISDOM,HDISDFFS,HDISADDF,HDISDIEN,HDISERRM) ;Find or Add a New Domain Entry
+1 ; Input -- HDISDOM Domain Name
+2 ; HDISDFFS Domain File/Field Array (Optional)
+3 ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
+4 ; Example: HDISDFFS(100.1)=""
+5 ; HDISADDF Add a New Entry Flag (Optional- Default 0)
+6 ; 1=Yes and 0=No
+7 ; Output -- 1=Successful and 0=Failure
+8 ; If Successful:
+9 ; HDISDIEN HDIS Domain file IEN
+10 ; If Failure:
+11 ; HDISERRM Error Message (Optional)
+12 NEW HDISOKF
+13 ;Initialize output
+14 SET (HDISDIEN,HDISERRM)=""
+15 ;Check for missing variable, exit if not defined
+16 IF $GET(HDISDOM)=""
Begin DoDot:1
+17 SET HDISERRM="Unable to Find or Add Domain. Required Variable Missing."
End DoDot:1
GOTO FINDDOMQ
+18 ;Check for existing Domain, return entry and exit if it exists
+19 IF $DATA(^HDIS(7115.1,"B",HDISDOM))
Begin DoDot:1
+20 SET HDISDIEN=$ORDER(^HDIS(7115.1,"B",HDISDOM,0))
+21 SET HDISOKF=1
End DoDot:1
IF $GET(HDISDIEN)
GOTO FINDDOMQ
+22 ;If flag set, Add a New Domain Entry
+23 IF $GET(HDISADDF)
SET HDISOKF=$$ADDDOM(HDISDOM,.HDISDFFS,.HDISDIEN,.HDISERRM)
FINDDOMQ QUIT +$GET(HDISOKF)
+1 ;
ADDDOM(HDISDOM,HDISDFFS,HDISDIEN,HDISERRM) ;Add a New Domain Entry
+1 ; Input -- HDISDOM Domain Name
+2 ; HDISDFFS Domain File/Field Array (Optional)
+3 ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
+4 ; Example: HDISDFFS(100.1)=""
+5 ; Output -- 1=Successful and 0=Failure
+6 ; If Successful:
+7 ; HDISDIEN HDIS Domain file IEN
+8 ; If Failure:
+9 ; HDISERRM Error Message (Optional)
+10 NEW HDISFDA,HDISIEN,HDISMSG,HDISOKF
+11 ;Initialize output
+12 SET (HDISDIEN,HDISERRM)=""
+13 ;Check for missing variable, exit if not defined
+14 IF $GET(HDISDOM)=""
Begin DoDot:1
+15 SET HDISERRM="Unable to Add Domain. Required Variable Missing."
End DoDot:1
GOTO ADDDOMQ
+16 ;Check for existing Domain, return error and exit if it exists
+17 IF $DATA(^HDIS(7115.1,"B",HDISDOM))
Begin DoDot:1
+18 SET HDISERRM="Domain already exists."
End DoDot:1
GOTO ADDDOMQ
+19 ;Set array for Domain Name
+20 SET HDISFDA(7115.1,"+1,",.01)=$GET(HDISDOM)
+21 DO UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
+22 ;Check for error
+23 IF $DATA(HDISMSG("DIERR"))
Begin DoDot:1
+24 SET HDISERRM=$GET(HDISMSG("DIERR",1,"TEXT",1))
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 SET HDISDIEN=+$GET(HDISIEN(1))
+27 SET HDISOKF=1
End DoDot:1
+28 DO CLEAN^DILF
+29 ;If Domain File/Field Array is passed, Add Domain File/Fields
+30 IF $GET(HDISDIEN)>0
IF $DATA(HDISDFFS)
SET HDISOKF=$$ADDDFFS(HDISDIEN,.HDISDFFS,.HDISERRM)
ADDDOMQ QUIT +$GET(HDISOKF)
+1 ;
ADDDFFS(HDISDIEN,HDISDFFS,HDISERRM) ;Add Domain File/Fields
+1 ; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
+2 ; HDISDFFS Domain File/Field Array
+3 ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
+4 ; Example: HDISDFFS(100.1)=""
+5 ; Output -- 1=Successful and 0=Failure
+6 ; If Failure:
+7 ; HDISERRM Error Message (Optional)
+8 NEW HDISCNT,HDISFARY,HDISFDA,HDISFFNM,HDISFIEN,HDISFILN,HDISFLDN,HDISIEN,HDISMSG,HDISOKF
+9 ;Initialize output
+10 SET HDISERRM=""
+11 ;Check for missing variables, exit if not defined
+12 IF $GET(HDISDIEN)'>0!('$DATA(HDISDFFS))
Begin DoDot:1
+13 SET HDISERRM="Unable to Add Domain File/Fields. Required Variable Missing."
End DoDot:1
GOTO ADDDFFSQ
+14 ;Add a new File/Field Entry
+15 SET HDISFILN=0
+16 FOR
SET HDISFILN=$ORDER(HDISDFFS(HDISFILN))
IF 'HDISFILN
QUIT
Begin DoDot:1
+17 ;Set Field Number to default of .01, if not defined
+18 SET HDISFLDN=$SELECT($GET(HDISDFFS(HDISFILN))>0:$GET(HDISDFFS(HDISFILN)),1:.01)
+19 IF $$ADDFFNM^HDISVF05(HDISFILN,HDISFLDN,.HDISFIEN,.HDISERRM)
Begin DoDot:2
+20 SET HDISFARY(HDISFIEN)=""
End DoDot:2
IF HDISERRM'=""
QUIT
+21 IF '$TEST
Begin DoDot:2
+22 ;Set error message, if unable to add file/field
+23 SET HDISERRM="Unable to Add File/Field "_HDISFILN_"~"_HDISFLDN_"."
End DoDot:2
End DoDot:1
IF HDISERRM'=""
GOTO ADDDFFSQ
+24 ;
+25 ;Set array for File/Field
+26 SET HDISFIEN=0
+27 SET HDISCNT=1
+28 FOR
SET HDISFIEN=$ORDER(HDISFARY(HDISFIEN))
IF 'HDISFIEN
QUIT
IF $DATA(^HDIS(7115.6,HDISFIEN,0))
SET HDISFFNM=$PIECE(^(0),"^",1)
Begin DoDot:1
+29 SET HDISCNT=HDISCNT+1
+30 SET HDISFDA(7115.11,"+"_HDISCNT_","_HDISDIEN_",",.01)=HDISFFNM
End DoDot:1
+31 DO UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
+32 ;Check for error
+33 IF $DATA(HDISMSG("DIERR"))
Begin DoDot:1
+34 SET HDISERRM=$GET(HDISMSG("DIERR",1,"TEXT",1))
End DoDot:1
+35 IF '$TEST
Begin DoDot:1
+36 SET HDISOKF=1
End DoDot:1
ADDDFFSQ QUIT +$GET(HDISOKF)
+1 ;
GETFILS(HDISDIEN,HDISCODE,HDISFILS) ;Get an Array of Files by Domain and Client Status Code
+1 ; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
+2 ; HDISCODE Client Status Code (Optional- Default 0=Not Started for Client)
+3 ; Output -- 1=Successful and 0=Failure
+4 ; If Successful:
+5 ; HDISFILS Array Subscripted by File # (i.e. HDISFILS(120.8)="")
+6 NEW HDISFIEN,HDISFILN,HDISFLDN
+7 ;Initialize ouput
+8 KILL HDISFILS
+9 ;Check for missing variable, exit if not defined
+10 IF $GET(HDISDIEN)'>0
GOTO GETFILSQ
+11 ;Set Status Code to default of 0=Not Started for Client, if needed
+12 SET HDISCODE=$SELECT('$DATA(HDISCODE):0,1:HDISCODE)
+13 ;Check Status of File/Fields and build array
+14 SET HDISFIEN=0
+15 FOR
SET HDISFIEN=$ORDER(^HDIS(7115.1,HDISDIEN,"FILE","B",HDISFIEN))
IF 'HDISFIEN
QUIT
Begin DoDot:1
+16 IF $$GETFF^HDISVF05(HDISFIEN,.HDISFILN,.HDISFLDN)
IF $PIECE($$GETSTAT^HDISVF01(HDISFILN,HDISFLDN),"^",1)=HDISCODE
Begin DoDot:2
+17 SET HDISFILS(HDISFILN)=""
End DoDot:2
End DoDot:1
GETFILSQ QUIT +$SELECT($DATA(HDISFILS):1,1:0)
+1 ;
GETIEN(HDISDOM,HDISDIEN) ;Get IEN for a Domain by Domain
+1 ; Input -- HDISDOM Domain Name
+2 ; Output -- 1=Successful and 0=Failure
+3 ; If Successful:
+4 ; HDISDIEN HDIS Domain file IEN
+5 ;Initialize ouput
+6 SET HDISDIEN=""
+7 ;Check for missing variable, exit if not defined
+8 IF $GET(HDISDOM)=""
GOTO GETIENQ
+9 ;Check for entry by Domain
+10 SET HDISDIEN=$ORDER(^HDIS(7115.1,"B",HDISDOM,0))
GETIENQ QUIT +$SELECT($GET(HDISDIEN)>0:1,1:0)
+1 ;
+2 ;---- End HDIS Domain file (#7115.1) API(s) ----
+3 ;
+4 ;Error processing utility
+5 ;
ERR(HDISP1,HDISP2,HDISP3) ;
+1 ;;Input: HDISP1 - Network Name (parameter 1 of bulletin)
+2 ;; HDISP2 - Date/Time (parameter 2 of bulletin)
+3 ;; HDISP3 - Error Message (parameter 3 of bulletin)
+4 ;;Output: None
+5 ;;
+6 NEW HDISP,HDISTASK,NAME,ERRARR,HDISE
+7 SET HDISE=""
SET ERRARR="HDISE"
SET HDISE(1)=""
+8 SET HDISP(1)=HDISP1
+9 SET Y=HDISP2
DO DD^%DT
SET HDISP(2)=Y
+10 SET HDISP(3)=HDISP3
+11 SET NAME="HDIS ERRORS"
+12 SET HDISFLAG("FROM")="HDIS DS Client"
+13 DO TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
+14 IF $GET(XMERR)
Begin DoDot:1
+15 ;Error generating bulletin - log error text
+16 DO ERR2XTMP^HDISVU01("HDI-XM","General error bulletin",$NAME(^TMP("XMERR",$JOB)))
+17 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
+18 QUIT
+19 ;
ERTBULL(HDISP1,HDISP2,HDISP3,HDISP4,HDISP5,HDISP6) ;
+1 NEW ERRARR,HDISP,NAME,HDISFLAG,HDISTASK
+2 SET ERRARR=$NAME(^TMP("HDIS ERRORS",$JOB))
SET ^TMP("HDIS ERRORS",$JOB,1)=""
+3 SET HDISP(1)=HDISP1
+4 SET HDISP(2)=HDISP2
+5 NEW Y
SET Y=HDISP3
DO DD^%DT
+6 SET HDISP(3)=Y
+7 SET HDISP(4)=HDISP4
+8 SET HDISP(5)=HDISP5
+9 SET HDISP(6)=HDISP6
+10 SET NAME="HDIS NOTIFY ERT"
+11 SET HDISFLAG("FROM")="HDIS Data Standardization Server"
+12 DO TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
+13 IF $GET(XMERR)
Begin DoDot:1
+14 ;Error generating bulletin - log error text
+15 DO ERR2XTMP^HDISVU01("HDI-XM","ERT bulletin",$NAME(^TMP("XMERR",$JOB)))
+16 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
+17 QUIT
+18 ;
MFSUP(HDISFILE,HDISERR,HDISFN) ; Update status to complete and send HDR Bulletin
+1 ;;Input: HDISFILE - File Number of file just updated (Required)
+2 ;; HDISERR - Error indicator from MFS (1 or 0) (Required)
+3 ;; HDISFN - Field number (Optional)
+4 ;;
+5 ;;Output: None
+6 NEW HDISCODE,HDISARRY,HDISOUT,HDISNM,HDISMESS,FILE,HDISTASK,NAME,OOPS,SYSTYPE,TMP
+7 SET HDISCODE=$$GETSTAT^HDISVF01(HDISFILE)
+8 SET FILE=HDISFILE
+9 IF $PIECE(HDISCODE,"^",1)'=4&($PIECE(HDISCODE,"^",1)'=5)
QUIT
+10 SET HDISARRY=$NAME(^TMP("HDIS STATUS",$JOB))
+11 IF $GET(HDISERR)
SET HDISNM=$GET(^XMB("NETNAME"))
DO ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),"Error from MFS")
SET HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,5,$$NOW^XLFDT(),HDISARRY,"")
DO SETSTAT^HDISVF01(HDISFILE,.01,5,$$NOW^XLFDT())
QUIT
+12 SET HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,6,$$NOW^XLFDT(),HDISARRY,"")
+13 IF HDISOUT=0
SET HDISMESS="Staus update to complete failed"
SET HDISNM=$GET(^XMB("NETNAME"))
DO ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS)
QUIT
+14 DO SETSTAT^HDISVF01(HDISFILE,.01,6,$$NOW^XLFDT())
+15 IF HDISOUT=0
SET HDISMESS="Staus update to complete failed"
SET HDISNM=$GET(^XMB("NETNAME"))
DO ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS)
QUIT
+16 ;Notify HDR that triggers should be turned on
+17 NEW FACPTR,FACNAME,FACNUM,DOMAIN,SYSTYP,FILENAME,HDISBDT
+18 SET OOPS=0
+19 IF '$$GETFAC^HDISVF07(,.FACPTR)
SET OOPS=1
+20 IF '$$GETDIP^HDISVF07(,.DOMAIN)
SET OOPS=1
+21 IF '$$GETTYPE^HDISVF07(,,.SYSTYPE)
SET OOPS=1
+22 IF OOPS=1
Begin DoDot:1
+23 SET FACPTR=$$FACPTR^HDISVF01()
+24 SET DOMAIN=$GET(^XMB("NETNAME"))
+25 SET SYSTYPE=$$PROD^XUPROD()
+26 SET SYSTYPE=$SELECT(SYSTYPE:"PRODUCTION",1:"TEST")
End DoDot:1
+27 SET TMP=$$NS^XUAF4(FACPTR)
+28 SET FACNAME=$PIECE(TMP,"^",1)
+29 SET FACNUM=$PIECE(TMP,"^",2)
+30 IF (FACNAME="")!(FACNUM="")
Begin DoDot:1
+31 SET TMP=$$SITE^VASITE()
+32 SET FACNAME=$PIECE(TMP,"^",2)
+33 SET FACNUM=$PIECE(TMP,"^",3)
End DoDot:1
+34 SET FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_DOMAIN
+35 SET FILENAME=$$GET1^DID(FILE,,,"NAME")
+36 SET FILENAME=FILENAME_" (#"_FILE_")"
+37 SET HDISBDT=$$NOW^XLFDT()
+38 SET ERRARR=$NAME(^TMP("HDIS ERRORS",$JOB))
SET ^TMP("HDIS ERRORS",$JOB,1)=""
+39 NEW HDISP
+40 SET HDISP(1)=FACNAME
+41 SET HDISP(2)=FILENAME
+42 NEW Y
SET Y=$$NOW^XLFDT()
DO DD^%DT
+43 SET HDISP(3)=Y
+44 SET HDISP(4)=SYSTYPE
+45 SET HDISP(5)=FACNUM
+46 SET HDISP(6)=FILE
+47 SET NAME="HDIS NOTIFY HDR"
+48 SET HDISFLAG("FROM")="HDIS Data Standardization Server"
+49 DO TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
+50 IF $GET(XMERR)
Begin DoDot:1
+51 ;Error generating bulletin - log error text
+52 DO ERR2XTMP^HDISVU01("HDI-XM","HDR bulletin",$NAME(^TMP("XMERR",$JOB)))
+53 KILL XMERR,^TMP("XMERR",$JOB)
End DoDot:1
+54 QUIT
