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

HDISVF07.m

Go to the documentation of this file.
  1. HDISVF07 ;ALB/RMO - 7118.21 File Utilities/API Cont.; 1/13/05@1:22:00
  1. ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
  1. ;
  1. ;---- Begin HDIS System file (#7118.21) API(s) ----
  1. ;
  1. FINDSYS(HDISDIPA,HDISFACN,HDISTYPE,HDISADDF,HDISYIEN,HDISERRM) ;Find or Add a System Entry
  1. ; Input -- HDISDIPA Domain/IP Address
  1. ; HDISFACN Facility Number (Optional- Default current facility number)
  1. ; HDISTYPE Type (Optional- Default current system)
  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. ; HDISYIEN HDIS System file IEN
  1. ; If Failure:
  1. ; HDISERRM Error Message (Optional)
  1. N HDISI,HDISIPTR,HDISOKF,HDISRSLT
  1. ;Initialize output
  1. S (HDISYIEN,HDISERRM)=""
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISDIPA)="" D G FINDSYSQ
  1. . S HDISERRM="Required Variable Missing."
  1. ;Set Facility Number to default of current facility number, if needed
  1. S HDISFACN=$S('$D(HDISFACN):$$FACNUM^HDISVF01,1:HDISFACN)
  1. ;Check Facility Number, return error and exit if no value
  1. I $G(HDISFACN)="" D G FINDSYSQ
  1. . S HDISERRM="Unable to determine Facility Number."
  1. ;Set Institution file (#4) IEN
  1. S HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
  1. ;Check Institution file (#4) IEN, return error and exit if no value
  1. I $G(HDISIPTR)'>0 D G FINDSYSQ
  1. . S HDISERRM="Unable to determine Institution file (#4) IEN."
  1. ;Set Type to default of current system, if needed
  1. S HDISTYPE=$S('$D(HDISTYPE):$$PROD^XUPROD,1:HDISTYPE)
  1. ;Convert HDISTYPE to internal value
  1. D CHK^DIE(7118.21,.03,"",HDISTYPE,.HDISRSLT)
  1. S HDISTYPE=HDISRSLT
  1. ;Check for existing Institution file (#4) IEN and Domain/IP Address, return entry and exit if it exists
  1. I $D(^HDISF(7118.21,"B",HDISIPTR)) D G FINDSYSQ:$G(HDISYIEN)
  1. . S HDISI=0
  1. . F S HDISI=$O(^HDISF(7118.21,"B",HDISIPTR,HDISI)) Q:'HDISI!($G(HDISYIEN)) D
  1. . . I $D(^HDISF(7118.21,HDISI,0)),$P(^(0),"^",2)=HDISDIPA D
  1. . . . S HDISYIEN=HDISI
  1. . . . S HDISOKF=1
  1. ;If flag is set, Add a New System Entry
  1. I $G(HDISADDF) S HDISOKF=$$ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,.HDISYIEN,.HDISERRM)
  1. ;
  1. FINDSYSQ Q +$G(HDISOKF)
  1. ;
  1. ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,HDISYIEN,HDISERRM) ;Add a New System Entry
  1. ; Input -- HDISIPTR Institution file (#4) IEN
  1. ; HDISDIPA Domain/IP Address
  1. ; HDISTYPE Type (Internal Value)
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISYIEN HDIS System file IEN
  1. ; If Failure:
  1. ; HDISERRM Error Message (Optional)
  1. N HDISFDA,HDISIEN,HDISMSG,HDISOKF
  1. ;Initialize output
  1. S (HDISYIEN,HDISERRM)=""
  1. ;Set array for Institution, Domain/IP Address and Type
  1. S HDISFDA(7118.21,"+1,",.01)=$G(HDISIPTR)
  1. S HDISFDA(7118.21,"+1,",.02)=$G(HDISDIPA)
  1. S HDISFDA(7118.21,"+1,",.03)=$G(HDISTYPE)
  1. D UPDATE^DIE("","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 HDISYIEN=+$G(HDISIEN(1))
  1. . S HDISOKF=1
  1. D CLEAN^DILF
  1. ADDSYSQ Q +$G(HDISOKF)
  1. ;
  1. CURSYS(HDISYIEN) ;Current System's HDIS System file IEN
  1. ; Input -- None
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISYIEN HDIS System file IEN
  1. N HDISFACN,HDISIPTR,HDISTYPE
  1. ;Initialize output
  1. S HDISYIEN=""
  1. ;Set Facility Number, Institution file (#4) IEN and Type
  1. S HDISFACN=$$FACNUM^HDISVF01
  1. S HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
  1. S HDISTYPE=$$PROD^XUPROD
  1. ;Check for entry by Type and Institution file (#4) IEN
  1. S HDISYIEN=$O(^HDISF(7118.21,"ATYP",+HDISTYPE,+HDISIPTR,0))
  1. CURSYSQ Q +$S($G(HDISYIEN)>0:1,1:0)
  1. ;
  1. GETFAC(HDISYIEN,HDISIPTR,HDISFACN) ;Get Institution file (#4) IEN and Facility Number by IEN
  1. ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISIPTR Institution file (#4) IEN
  1. ; HDISFACN Facility Number
  1. ;Initialize output
  1. S (HDISIPTR,HDISFACN)=""
  1. ;Set HDIS System file IEN to current system, if needed
  1. I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISYIEN)'>0 G GETFACQ
  1. ;Check for Institution file (#4) IEN and Facility Number by IEN
  1. I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISIPTR=$P($G(^(0)),"^",1) D
  1. . S HDISFACN=$$FACNUM^HDISVF01(HDISIPTR)
  1. GETFACQ Q +$S($G(HDISIPTR)'=""&($G(HDISFACN)'=""):1,1:0)
  1. ;
  1. GETDIP(HDISYIEN,HDISDIPA) ;Get Domain/IP Address by IEN
  1. ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISDIPA Domain/IP Address
  1. ;Initialize output
  1. S HDISDIPA=""
  1. ;Set HDIS System file IEN to current system, if needed
  1. I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISYIEN)'>0 G GETDIPQ
  1. ;Check for Domain/IP Address by IEN
  1. I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISDIPA=$P($G(^(0)),"^",2)
  1. GETDIPQ Q +$S($G(HDISDIPA)'="":1,1:0)
  1. ;
  1. ;
  1. GETTYPE(HDISYIEN,HDISTYPE,HDISTYPX) ;Get Type (Internal and External Value) by IEN
  1. ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
  1. ; Output -- 1=Successful and 0=Failure
  1. ; If Successful:
  1. ; HDISTYPE Type (Internal Value)
  1. ; HDISTYPX Type (External Value)
  1. ;Initialize output
  1. S (HDISTYPE,HDISTYPX)=""
  1. ;Set HDIS System file IEN to current system, if needed
  1. I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
  1. ;Check for missing variable, exit if not defined
  1. I $G(HDISYIEN)'>0 G GETTYPEQ
  1. ;Check for Domain/IP Address by IEN
  1. I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISTYPE=$P($G(^(0)),"^",3) D
  1. . S HDISTYPX=$$GET1^DIQ(7118.21,HDISYIEN,.03)
  1. GETTYPEQ Q +$S($G(HDISTYPE)'=""&($G(HDISTYPX)'=""):1,1:0)
  1. ;
  1. ;---- End HDIS System file (#7118.21) API(s) ----