Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HDISVF09

HDISVF09.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;---- Begin HDIS Domain file (#7115.1) API(s) ----
  1. ;
  1. FINDDOM(HDISDOM,HDISDFFS,HDISADDF,HDISDIEN,HDISERRM) ;Find or Add a New Domain Entry
  1. ; Input -- HDISDOM Domain Name
  1. ; HDISDFFS Domain File/Field Array (Optional)
  1. ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
  1. ; Example: HDISDFFS(100.1)=""
  1. ; HDISADDF Add a New Entry Flag (Optional- Default 0)
  1. ; 1=Yes and 0=No
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISDIEN HDIS Domain file IEN
  1. ; If Failure:
  1. ; HDISERRM Error Message (Optional)
  1. N HDISOKF
  1. ;Initialize output
  1. S (HDISDIEN,HDISERRM)=""
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISDOM)="" D G FINDDOMQ
  1. . S HDISERRM="Unable to Find or Add Domain. Required Variable Missing."
  1. ;Check for existing Domain, return entry and exit if it exists
  1. I $D(^HDIS(7115.1,"B",HDISDOM)) D G FINDDOMQ:$G(HDISDIEN)
  1. . S HDISDIEN=$O(^HDIS(7115.1,"B",HDISDOM,0))
  1. . S HDISOKF=1
  1. ;If flag set, Add a New Domain Entry
  1. I $G(HDISADDF) S HDISOKF=$$ADDDOM(HDISDOM,.HDISDFFS,.HDISDIEN,.HDISERRM)
  1. FINDDOMQ Q +$G(HDISOKF)
  1. ;
  1. ADDDOM(HDISDOM,HDISDFFS,HDISDIEN,HDISERRM) ;Add a New Domain Entry
  1. ; Input -- HDISDOM Domain Name
  1. ; HDISDFFS Domain File/Field Array (Optional)
  1. ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
  1. ; Example: HDISDFFS(100.1)=""
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISDIEN HDIS Domain file IEN
  1. ; If Failure:
  1. ; HDISERRM Error Message (Optional)
  1. N HDISFDA,HDISIEN,HDISMSG,HDISOKF
  1. ;Initialize output
  1. S (HDISDIEN,HDISERRM)=""
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISDOM)="" D G ADDDOMQ
  1. . S HDISERRM="Unable to Add Domain. Required Variable Missing."
  1. ;Check for existing Domain, return error and exit if it exists
  1. I $D(^HDIS(7115.1,"B",HDISDOM)) D G ADDDOMQ
  1. . S HDISERRM="Domain already exists."
  1. ;Set array for Domain Name
  1. S HDISFDA(7115.1,"+1,",.01)=$G(HDISDOM)
  1. D UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
  1. ;Check for error
  1. I $D(HDISMSG("DIERR")) D
  1. . S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
  1. ELSE D
  1. . S HDISDIEN=+$G(HDISIEN(1))
  1. . S HDISOKF=1
  1. D CLEAN^DILF
  1. ;If Domain File/Field Array is passed, Add Domain File/Fields
  1. I $G(HDISDIEN)>0,$D(HDISDFFS) S HDISOKF=$$ADDDFFS(HDISDIEN,.HDISDFFS,.HDISERRM)
  1. ADDDOMQ Q +$G(HDISOKF)
  1. ;
  1. ADDDFFS(HDISDIEN,HDISDFFS,HDISERRM) ;Add Domain File/Fields
  1. ; Input -- HDISDIEN HDIS Domain file (#7115.1) IEN
  1. ; HDISDFFS Domain File/Field Array
  1. ; Pass by HDISDFFS(File #)=Field # (Field # optional- Default .01)
  1. ; Example: HDISDFFS(100.1)=""
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Failure:
  1. ; HDISERRM Error Message (Optional)
  1. N HDISCNT,HDISFARY,HDISFDA,HDISFFNM,HDISFIEN,HDISFILN,HDISFLDN,HDISIEN,HDISMSG,HDISOKF
  1. ;Initialize output
  1. S HDISERRM=""
  1. ;Check for missing variables, exit if not defined
  1. I $G(HDISDIEN)'>0!('$D(HDISDFFS)) D G ADDDFFSQ
  1. . S HDISERRM="Unable to Add Domain File/Fields. Required Variable Missing."
  1. ;Add a new File/Field Entry
  1. S HDISFILN=0
  1. F S HDISFILN=$O(HDISDFFS(HDISFILN)) Q:'HDISFILN D G ADDDFFSQ:HDISERRM'=""
  1. . ;Set Field Number to default of .01, if not defined
  1. . S HDISFLDN=$S($G(HDISDFFS(HDISFILN))>0:$G(HDISDFFS(HDISFILN)),1:.01)
  1. . I $$ADDFFNM^HDISVF05(HDISFILN,HDISFLDN,.HDISFIEN,.HDISERRM) D Q:HDISERRM'=""
  1. . . S HDISFARY(HDISFIEN)=""
  1. . ELSE D
  1. . . ;Set error message, if unable to add file/field
  1. . . S HDISERRM="Unable to Add File/Field "_HDISFILN_"~"_HDISFLDN_"."
  1. ;
  1. ;Set array for File/Field
  1. S HDISFIEN=0
  1. S HDISCNT=1
  1. F S HDISFIEN=$O(HDISFARY(HDISFIEN)) Q:'HDISFIEN I $D(^HDIS(7115.6,HDISFIEN,0)) S HDISFFNM=$P(^(0),"^",1) D
  1. . S HDISCNT=HDISCNT+1
  1. . S HDISFDA(7115.11,"+"_HDISCNT_","_HDISDIEN_",",.01)=HDISFFNM
  1. D UPDATE^DIE("E","HDISFDA","HDISIEN","HDISMSG")
  1. ;Check for error
  1. I $D(HDISMSG("DIERR")) D
  1. . S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
  1. ELSE D
  1. . S HDISOKF=1
  1. ADDDFFSQ Q +$G(HDISOKF)
  1. ;
  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
  1. ; HDISCODE Client Status Code (Optional- Default 0=Not Started for Client)
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISFILS Array Subscripted by File # (i.e. HDISFILS(120.8)="")
  1. N HDISFIEN,HDISFILN,HDISFLDN
  1. ;Initialize ouput
  1. K HDISFILS
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISDIEN)'>0 G GETFILSQ
  1. ;Set Status Code to default of 0=Not Started for Client, if needed
  1. S HDISCODE=$S('$D(HDISCODE):0,1:HDISCODE)
  1. ;Check Status of File/Fields and build array
  1. S HDISFIEN=0
  1. F S HDISFIEN=$O(^HDIS(7115.1,HDISDIEN,"FILE","B",HDISFIEN)) Q:'HDISFIEN D
  1. . I $$GETFF^HDISVF05(HDISFIEN,.HDISFILN,.HDISFLDN),$P($$GETSTAT^HDISVF01(HDISFILN,HDISFLDN),"^",1)=HDISCODE D
  1. . . S HDISFILS(HDISFILN)=""
  1. GETFILSQ Q +$S($D(HDISFILS):1,1:0)
  1. ;
  1. GETIEN(HDISDOM,HDISDIEN) ;Get IEN for a Domain by Domain
  1. ; Input -- HDISDOM Domain Name
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISDIEN HDIS Domain file IEN
  1. ;Initialize ouput
  1. S HDISDIEN=""
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISDOM)="" G GETIENQ
  1. ;Check for entry by Domain
  1. S HDISDIEN=$O(^HDIS(7115.1,"B",HDISDOM,0))
  1. GETIENQ Q +$S($G(HDISDIEN)>0:1,1:0)
  1. ;
  1. ;---- End HDIS Domain file (#7115.1) API(s) ----
  1. ;
  1. ;Error processing utility
  1. ;
  1. ERR(HDISP1,HDISP2,HDISP3) ;
  1. ;;Input: HDISP1 - Network Name (parameter 1 of bulletin)
  1. ;; HDISP2 - Date/Time (parameter 2 of bulletin)
  1. ;; HDISP3 - Error Message (parameter 3 of bulletin)
  1. ;;Output: None
  1. ;;
  1. N HDISP,HDISTASK,NAME,ERRARR,HDISE
  1. S HDISE="" S ERRARR="HDISE",HDISE(1)=""
  1. S HDISP(1)=HDISP1
  1. S Y=HDISP2 D DD^%DT S HDISP(2)=Y
  1. S HDISP(3)=HDISP3
  1. S NAME="HDIS ERRORS"
  1. S HDISFLAG("FROM")="HDIS DS Client"
  1. D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
  1. I $G(XMERR) D
  1. .;Error generating bulletin - log error text
  1. .D ERR2XTMP^HDISVU01("HDI-XM","General error bulletin",$NA(^TMP("XMERR",$J)))
  1. .K XMERR,^TMP("XMERR",$J)
  1. Q
  1. ;
  1. ERTBULL(HDISP1,HDISP2,HDISP3,HDISP4,HDISP5,HDISP6) ;
  1. N ERRARR,HDISP,NAME,HDISFLAG,HDISTASK
  1. S ERRARR=$NA(^TMP("HDIS ERRORS",$J)),^TMP("HDIS ERRORS",$J,1)=""
  1. S HDISP(1)=HDISP1
  1. S HDISP(2)=HDISP2
  1. N Y S Y=HDISP3 D DD^%DT
  1. S HDISP(3)=Y
  1. S HDISP(4)=HDISP4
  1. S HDISP(5)=HDISP5
  1. S HDISP(6)=HDISP6
  1. S NAME="HDIS NOTIFY ERT"
  1. S HDISFLAG("FROM")="HDIS Data Standardization Server"
  1. D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
  1. I $G(XMERR) D
  1. .;Error generating bulletin - log error text
  1. .D ERR2XTMP^HDISVU01("HDI-XM","ERT bulletin",$NA(^TMP("XMERR",$J)))
  1. .K XMERR,^TMP("XMERR",$J)
  1. Q
  1. ;
  1. MFSUP(HDISFILE,HDISERR,HDISFN) ; Update status to complete and send HDR Bulletin
  1. ;;Input: HDISFILE - File Number of file just updated (Required)
  1. ;; HDISERR - Error indicator from MFS (1 or 0) (Required)
  1. ;; HDISFN - Field number (Optional)
  1. ;;
  1. ;;Output: None
  1. N HDISCODE,HDISARRY,HDISOUT,HDISNM,HDISMESS,FILE,HDISTASK,NAME,OOPS,SYSTYPE,TMP
  1. S HDISCODE=$$GETSTAT^HDISVF01(HDISFILE)
  1. S FILE=HDISFILE
  1. Q:$P(HDISCODE,"^",1)'=4&($P(HDISCODE,"^",1)'=5)
  1. S HDISARRY=$NA(^TMP("HDIS STATUS",$J))
  1. 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
  1. S HDISOUT=$$BLDSND^HDISVCUT(HDISFILE,.01,6,$$NOW^XLFDT(),HDISARRY,"")
  1. I HDISOUT=0 S HDISMESS="Staus update to complete failed",HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS) Q
  1. D SETSTAT^HDISVF01(HDISFILE,.01,6,$$NOW^XLFDT())
  1. I HDISOUT=0 S HDISMESS="Staus update to complete failed",HDISNM=$G(^XMB("NETNAME")) D ERR^HDISVF09(HDISNM,$$NOW^XLFDT(),HDISMESS) Q
  1. ;Notify HDR that triggers should be turned on
  1. N FACPTR,FACNAME,FACNUM,DOMAIN,SYSTYP,FILENAME,HDISBDT
  1. S OOPS=0
  1. I '$$GETFAC^HDISVF07(,.FACPTR) S OOPS=1
  1. I '$$GETDIP^HDISVF07(,.DOMAIN) S OOPS=1
  1. I '$$GETTYPE^HDISVF07(,,.SYSTYPE) S OOPS=1
  1. I OOPS=1 D
  1. .S FACPTR=$$FACPTR^HDISVF01()
  1. .S DOMAIN=$G(^XMB("NETNAME"))
  1. .S SYSTYPE=$$PROD^XUPROD()
  1. .S SYSTYPE=$S(SYSTYPE:"PRODUCTION",1:"TEST")
  1. S TMP=$$NS^XUAF4(FACPTR)
  1. S FACNAME=$P(TMP,"^",1)
  1. S FACNUM=$P(TMP,"^",2)
  1. I (FACNAME="")!(FACNUM="") D
  1. .S TMP=$$SITE^VASITE()
  1. .S FACNAME=$P(TMP,"^",2)
  1. .S FACNUM=$P(TMP,"^",3)
  1. S FACNAME=FACNAME_" (#"_FACNUM_") with Domain/IP Address "_DOMAIN
  1. S FILENAME=$$GET1^DID(FILE,,,"NAME")
  1. S FILENAME=FILENAME_" (#"_FILE_")"
  1. S HDISBDT=$$NOW^XLFDT()
  1. S ERRARR=$NA(^TMP("HDIS ERRORS",$J)),^TMP("HDIS ERRORS",$J,1)=""
  1. N HDISP
  1. S HDISP(1)=FACNAME
  1. S HDISP(2)=FILENAME
  1. N Y S Y=$$NOW^XLFDT() D DD^%DT
  1. S HDISP(3)=Y
  1. S HDISP(4)=SYSTYPE
  1. S HDISP(5)=FACNUM
  1. S HDISP(6)=FILE
  1. S NAME="HDIS NOTIFY HDR"
  1. S HDISFLAG("FROM")="HDIS Data Standardization Server"
  1. D TASKBULL^XMXAPI(DUZ,NAME,.HDISP,ERRARR,,.HDISFLAG,.HDISTASK)
  1. I $G(XMERR) D
  1. .;Error generating bulletin - log error text
  1. .D ERR2XTMP^HDISVU01("HDI-XM","HDR bulletin",$NA(^TMP("XMERR",$J)))
  1. .K XMERR,^TMP("XMERR",$J)
  1. Q