HDISVF07 ;ALB/RMO - 7118.21 File Utilities/API Cont.; 1/13/05@1:22:00
;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
;
;---- Begin HDIS System file (#7118.21) API(s) ----
;
FINDSYS(HDISDIPA,HDISFACN,HDISTYPE,HDISADDF,HDISYIEN,HDISERRM) ;Find or Add a System Entry
; Input -- HDISDIPA Domain/IP Address
; HDISFACN Facility Number (Optional- Default current facility number)
; HDISTYPE Type (Optional- Default current system)
; HDISADDF Add a New Entry Flag (Optional- Default 0)
; 1=Yes and 0=No
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISYIEN HDIS System file IEN
; If Failure:
; HDISERRM Error Message (Optional)
N HDISI,HDISIPTR,HDISOKF,HDISRSLT
;Initialize output
S (HDISYIEN,HDISERRM)=""
;Check for missing variable, exit if not defined
I $G(HDISDIPA)="" D G FINDSYSQ
. S HDISERRM="Required Variable Missing."
;Set Facility Number to default of current facility number, if needed
S HDISFACN=$S('$D(HDISFACN):$$FACNUM^HDISVF01,1:HDISFACN)
;Check Facility Number, return error and exit if no value
I $G(HDISFACN)="" D G FINDSYSQ
. S HDISERRM="Unable to determine Facility Number."
;Set Institution file (#4) IEN
S HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
;Check Institution file (#4) IEN, return error and exit if no value
I $G(HDISIPTR)'>0 D G FINDSYSQ
. S HDISERRM="Unable to determine Institution file (#4) IEN."
;Set Type to default of current system, if needed
S HDISTYPE=$S('$D(HDISTYPE):$$PROD^XUPROD,1:HDISTYPE)
;Convert HDISTYPE to internal value
D CHK^DIE(7118.21,.03,"",HDISTYPE,.HDISRSLT)
S HDISTYPE=HDISRSLT
;Check for existing Institution file (#4) IEN and Domain/IP Address, return entry and exit if it exists
I $D(^HDISF(7118.21,"B",HDISIPTR)) D G FINDSYSQ:$G(HDISYIEN)
. S HDISI=0
. F S HDISI=$O(^HDISF(7118.21,"B",HDISIPTR,HDISI)) Q:'HDISI!($G(HDISYIEN)) D
. . I $D(^HDISF(7118.21,HDISI,0)),$P(^(0),"^",2)=HDISDIPA D
. . . S HDISYIEN=HDISI
. . . S HDISOKF=1
;If flag is set, Add a New System Entry
I $G(HDISADDF) S HDISOKF=$$ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,.HDISYIEN,.HDISERRM)
;
FINDSYSQ Q +$G(HDISOKF)
;
ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,HDISYIEN,HDISERRM) ;Add a New System Entry
; Input -- HDISIPTR Institution file (#4) IEN
; HDISDIPA Domain/IP Address
; HDISTYPE Type (Internal Value)
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISYIEN HDIS System file IEN
; If Failure:
; HDISERRM Error Message (Optional)
N HDISFDA,HDISIEN,HDISMSG,HDISOKF
;Initialize output
S (HDISYIEN,HDISERRM)=""
;Set array for Institution, Domain/IP Address and Type
S HDISFDA(7118.21,"+1,",.01)=$G(HDISIPTR)
S HDISFDA(7118.21,"+1,",.02)=$G(HDISDIPA)
S HDISFDA(7118.21,"+1,",.03)=$G(HDISTYPE)
D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
;Check for error
I $D(HDISMSG("DIERR")) D
. S HDISERRM=$G(HDISMSG("DIERR",1,"TEXT",1))
ELSE D
. S HDISYIEN=+$G(HDISIEN(1))
. S HDISOKF=1
D CLEAN^DILF
ADDSYSQ Q +$G(HDISOKF)
;
CURSYS(HDISYIEN) ;Current System's HDIS System file IEN
; Input -- None
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISYIEN HDIS System file IEN
N HDISFACN,HDISIPTR,HDISTYPE
;Initialize output
S HDISYIEN=""
;Set Facility Number, Institution file (#4) IEN and Type
S HDISFACN=$$FACNUM^HDISVF01
S HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
S HDISTYPE=$$PROD^XUPROD
;Check for entry by Type and Institution file (#4) IEN
S HDISYIEN=$O(^HDISF(7118.21,"ATYP",+HDISTYPE,+HDISIPTR,0))
CURSYSQ Q +$S($G(HDISYIEN)>0:1,1:0)
;
GETFAC(HDISYIEN,HDISIPTR,HDISFACN) ;Get Institution file (#4) IEN and Facility Number by IEN
; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISIPTR Institution file (#4) IEN
; HDISFACN Facility Number
;Initialize output
S (HDISIPTR,HDISFACN)=""
;Set HDIS System file IEN to current system, if needed
I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
;Check for missing variable, exit if not defined
I $G(HDISYIEN)'>0 G GETFACQ
;Check for Institution file (#4) IEN and Facility Number by IEN
I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISIPTR=$P($G(^(0)),"^",1) D
. S HDISFACN=$$FACNUM^HDISVF01(HDISIPTR)
GETFACQ Q +$S($G(HDISIPTR)'=""&($G(HDISFACN)'=""):1,1:0)
;
GETDIP(HDISYIEN,HDISDIPA) ;Get Domain/IP Address by IEN
; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISDIPA Domain/IP Address
;Initialize output
S HDISDIPA=""
;Set HDIS System file IEN to current system, if needed
I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
;Check for missing variable, exit if not defined
I $G(HDISYIEN)'>0 G GETDIPQ
;Check for Domain/IP Address by IEN
I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISDIPA=$P($G(^(0)),"^",2)
GETDIPQ Q +$S($G(HDISDIPA)'="":1,1:0)
;
;
GETTYPE(HDISYIEN,HDISTYPE,HDISTYPX) ;Get Type (Internal and External Value) by IEN
; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
; Output -- 1=Successful and 0=Failure
; If Successful:
; HDISTYPE Type (Internal Value)
; HDISTYPX Type (External Value)
;Initialize output
S (HDISTYPE,HDISTYPX)=""
;Set HDIS System file IEN to current system, if needed
I '$D(HDISYIEN),$$CURSYS(.HDISYIEN)
;Check for missing variable, exit if not defined
I $G(HDISYIEN)'>0 G GETTYPEQ
;Check for Domain/IP Address by IEN
I $D(^HDISF(7118.21,HDISYIEN,0)) S HDISTYPE=$P($G(^(0)),"^",3) D
. S HDISTYPX=$$GET1^DIQ(7118.21,HDISYIEN,.03)
GETTYPEQ Q +$S($G(HDISTYPE)'=""&($G(HDISTYPX)'=""):1,1:0)
;
;---- End HDIS System file (#7118.21) API(s) ----
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVF07 5956 printed Sep 23, 2025@19:32:57 Page 2
HDISVF07 ;ALB/RMO - 7118.21 File Utilities/API Cont.; 1/13/05@1:22:00
+1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
+2 ;
+3 ;---- Begin HDIS System file (#7118.21) API(s) ----
+4 ;
FINDSYS(HDISDIPA,HDISFACN,HDISTYPE,HDISADDF,HDISYIEN,HDISERRM) ;Find or Add a System Entry
+1 ; Input -- HDISDIPA Domain/IP Address
+2 ; HDISFACN Facility Number (Optional- Default current facility number)
+3 ; HDISTYPE Type (Optional- Default current system)
+4 ; HDISADDF Add a New Entry Flag (Optional- Default 0)
+5 ; 1=Yes and 0=No
+6 ; Output -- 1=Successful and 0=Failure
+7 ; If Successful:
+8 ; HDISYIEN HDIS System file IEN
+9 ; If Failure:
+10 ; HDISERRM Error Message (Optional)
+11 NEW HDISI,HDISIPTR,HDISOKF,HDISRSLT
+12 ;Initialize output
+13 SET (HDISYIEN,HDISERRM)=""
+14 ;Check for missing variable, exit if not defined
+15 IF $GET(HDISDIPA)=""
Begin DoDot:1
+16 SET HDISERRM="Required Variable Missing."
End DoDot:1
GOTO FINDSYSQ
+17 ;Set Facility Number to default of current facility number, if needed
+18 SET HDISFACN=$SELECT('$DATA(HDISFACN):$$FACNUM^HDISVF01,1:HDISFACN)
+19 ;Check Facility Number, return error and exit if no value
+20 IF $GET(HDISFACN)=""
Begin DoDot:1
+21 SET HDISERRM="Unable to determine Facility Number."
End DoDot:1
GOTO FINDSYSQ
+22 ;Set Institution file (#4) IEN
+23 SET HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
+24 ;Check Institution file (#4) IEN, return error and exit if no value
+25 IF $GET(HDISIPTR)'>0
Begin DoDot:1
+26 SET HDISERRM="Unable to determine Institution file (#4) IEN."
End DoDot:1
GOTO FINDSYSQ
+27 ;Set Type to default of current system, if needed
+28 SET HDISTYPE=$SELECT('$DATA(HDISTYPE):$$PROD^XUPROD,1:HDISTYPE)
+29 ;Convert HDISTYPE to internal value
+30 DO CHK^DIE(7118.21,.03,"",HDISTYPE,.HDISRSLT)
+31 SET HDISTYPE=HDISRSLT
+32 ;Check for existing Institution file (#4) IEN and Domain/IP Address, return entry and exit if it exists
+33 IF $DATA(^HDISF(7118.21,"B",HDISIPTR))
Begin DoDot:1
+34 SET HDISI=0
+35 FOR
SET HDISI=$ORDER(^HDISF(7118.21,"B",HDISIPTR,HDISI))
if 'HDISI!($GET(HDISYIEN))
QUIT
Begin DoDot:2
+36 IF $DATA(^HDISF(7118.21,HDISI,0))
IF $PIECE(^(0),"^",2)=HDISDIPA
Begin DoDot:3
+37 SET HDISYIEN=HDISI
+38 SET HDISOKF=1
End DoDot:3
End DoDot:2
End DoDot:1
if $GET(HDISYIEN)
GOTO FINDSYSQ
+39 ;If flag is set, Add a New System Entry
+40 IF $GET(HDISADDF)
SET HDISOKF=$$ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,.HDISYIEN,.HDISERRM)
+41 ;
FINDSYSQ QUIT +$GET(HDISOKF)
+1 ;
ADDSYS(HDISIPTR,HDISDIPA,HDISTYPE,HDISYIEN,HDISERRM) ;Add a New System Entry
+1 ; Input -- HDISIPTR Institution file (#4) IEN
+2 ; HDISDIPA Domain/IP Address
+3 ; HDISTYPE Type (Internal Value)
+4 ; Output -- 1=Successful and 0=Failure
+5 ; If Successful:
+6 ; HDISYIEN HDIS System file IEN
+7 ; If Failure:
+8 ; HDISERRM Error Message (Optional)
+9 NEW HDISFDA,HDISIEN,HDISMSG,HDISOKF
+10 ;Initialize output
+11 SET (HDISYIEN,HDISERRM)=""
+12 ;Set array for Institution, Domain/IP Address and Type
+13 SET HDISFDA(7118.21,"+1,",.01)=$GET(HDISIPTR)
+14 SET HDISFDA(7118.21,"+1,",.02)=$GET(HDISDIPA)
+15 SET HDISFDA(7118.21,"+1,",.03)=$GET(HDISTYPE)
+16 DO UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
+17 ;Check for error
+18 IF $DATA(HDISMSG("DIERR"))
Begin DoDot:1
+19 SET HDISERRM=$GET(HDISMSG("DIERR",1,"TEXT",1))
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET HDISYIEN=+$GET(HDISIEN(1))
+22 SET HDISOKF=1
End DoDot:1
+23 DO CLEAN^DILF
ADDSYSQ QUIT +$GET(HDISOKF)
+1 ;
CURSYS(HDISYIEN) ;Current System's HDIS System file IEN
+1 ; Input -- None
+2 ; Output -- 1=Successful and 0=Failure
+3 ; If Successful:
+4 ; HDISYIEN HDIS System file IEN
+5 NEW HDISFACN,HDISIPTR,HDISTYPE
+6 ;Initialize output
+7 SET HDISYIEN=""
+8 ;Set Facility Number, Institution file (#4) IEN and Type
+9 SET HDISFACN=$$FACNUM^HDISVF01
+10 SET HDISIPTR=$$FACPTR^HDISVF01(HDISFACN)
+11 SET HDISTYPE=$$PROD^XUPROD
+12 ;Check for entry by Type and Institution file (#4) IEN
+13 SET HDISYIEN=$ORDER(^HDISF(7118.21,"ATYP",+HDISTYPE,+HDISIPTR,0))
CURSYSQ QUIT +$SELECT($GET(HDISYIEN)>0:1,1:0)
+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)
+2 ; Output -- 1=Successful and 0=Failure
+3 ; If Successful:
+4 ; HDISIPTR Institution file (#4) IEN
+5 ; HDISFACN Facility Number
+6 ;Initialize output
+7 SET (HDISIPTR,HDISFACN)=""
+8 ;Set HDIS System file IEN to current system, if needed
+9 IF '$DATA(HDISYIEN)
IF $$CURSYS(.HDISYIEN)
+10 ;Check for missing variable, exit if not defined
+11 IF $GET(HDISYIEN)'>0
GOTO GETFACQ
+12 ;Check for Institution file (#4) IEN and Facility Number by IEN
+13 IF $DATA(^HDISF(7118.21,HDISYIEN,0))
SET HDISIPTR=$PIECE($GET(^(0)),"^",1)
Begin DoDot:1
+14 SET HDISFACN=$$FACNUM^HDISVF01(HDISIPTR)
End DoDot:1
GETFACQ QUIT +$SELECT($GET(HDISIPTR)'=""&($GET(HDISFACN)'=""):1,1:0)
+1 ;
GETDIP(HDISYIEN,HDISDIPA) ;Get Domain/IP Address by IEN
+1 ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
+2 ; Output -- 1=Successful and 0=Failure
+3 ; If Successful:
+4 ; HDISDIPA Domain/IP Address
+5 ;Initialize output
+6 SET HDISDIPA=""
+7 ;Set HDIS System file IEN to current system, if needed
+8 IF '$DATA(HDISYIEN)
IF $$CURSYS(.HDISYIEN)
+9 ;Check for missing variable, exit if not defined
+10 IF $GET(HDISYIEN)'>0
GOTO GETDIPQ
+11 ;Check for Domain/IP Address by IEN
+12 IF $DATA(^HDISF(7118.21,HDISYIEN,0))
SET HDISDIPA=$PIECE($GET(^(0)),"^",2)
GETDIPQ QUIT +$SELECT($GET(HDISDIPA)'="":1,1:0)
+1 ;
+2 ;
GETTYPE(HDISYIEN,HDISTYPE,HDISTYPX) ;Get Type (Internal and External Value) by IEN
+1 ; Input -- HDISYIEN HDIS System file IEN (Optional- Default current system)
+2 ; Output -- 1=Successful and 0=Failure
+3 ; If Successful:
+4 ; HDISTYPE Type (Internal Value)
+5 ; HDISTYPX Type (External Value)
+6 ;Initialize output
+7 SET (HDISTYPE,HDISTYPX)=""
+8 ;Set HDIS System file IEN to current system, if needed
+9 IF '$DATA(HDISYIEN)
IF $$CURSYS(.HDISYIEN)
+10 ;Check for missing variable, exit if not defined
+11 IF $GET(HDISYIEN)'>0
GOTO GETTYPEQ
+12 ;Check for Domain/IP Address by IEN
+13 IF $DATA(^HDISF(7118.21,HDISYIEN,0))
SET HDISTYPE=$PIECE($GET(^(0)),"^",3)
Begin DoDot:1
+14 SET HDISTYPX=$$GET1^DIQ(7118.21,HDISYIEN,.03)
End DoDot:1
GETTYPEQ QUIT +$SELECT($GET(HDISTYPE)'=""&($GET(HDISTYPX)'=""):1,1:0)
+1 ;
+2 ;---- End HDIS System file (#7118.21) API(s) ----
