- 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 Feb 18, 2025@23:23:12 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) ----