- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVF09 9601 printed Feb 18, 2025@23:23:14 Page 2
- 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