HDISVF02 ;BPFO/JRP - FILE UTILITIES/API;12/20/2004
;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
;
;---------- Begin HDIS PARAMETER file (#7118.29) APIs ----------
;
GETTYPE(SYSPTR) ;Get value of SYSTEM TYPE field (#.02)
; Input : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : Internal Value ^ External Value
; Notes : If no value found, values for client system type returned
N FAC,ARR,NTRNL,XTRNL
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q "1^CLIENT"
S XTRNL=$$GET(7118.29,.02,(FAC_","),"B",.ARR)
I XTRNL="" Q "1^CLIENT"
Q ARR("I")_"^"_XTRNL
;
SETTYPE(VALUE,SYSPTR) ;Set value of SYSTEM TYPE field (#.02)
; Input : VALUE - New value (internal or external)
; : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : None
N FAC,X,HDIVAL,HDIERR
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q
;Convert VALUE to internal - allows changing of uneditable field
D CHK^DIE(7118.29,.02,"",$G(VALUE),.HDIVAL,"HDIERR")
I HDIVAL="^" Q
S X=$$SET(7118.29,.02,(FAC_","),HDIVAL,0)
Q
;
GETVFAIL(SYSPTR) ;Get value of DISABLE VUID ACTIVITY field (#11)
; Input : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : Internal Value ^ External Value
; Notes : If no value found, values for OFF are returned
N FAC,ARR,NTRNL,XTRNL
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q "0^OFF"
S XTRNL=$$GET(7118.29,11,(FAC_","),"B",.ARR)
I XTRNL="" Q "0^OFF"
Q ARR("I")_"^"_XTRNL
;
SETVFAIL(VALUE,SYSPTR) ;Set value of DISABLE VUID ACTIVITY field (#11)
; Input : VALUE - New value (internal or external)
; : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : None
N FAC,X
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q
S X=$$SET(7118.29,11,(FAC_","),$G(VALUE),1)
Q
;
GETVLOC(SYSPTR) ;Get value of VUID SERVER LOCATION field (#12)
; Input : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : Value of field
; Notes : If no value found, domain for FORUM returned
N FAC,XTRNL
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q "DOMAIN.EXT"
S XTRNL=$$GET(7118.29,12,(FAC_","),"E")
I XTRNL="" Q "DOMAIN.EXT"
Q XTRNL
;
SETVLOC(VALUE,SYSPTR) ;Set value of VUID SERVER LOCATION field (#12)
; Input : VALUE - New value (internal or external)
; : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : None
N FAC,X
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q
S X=$$SET(7118.29,12,(FAC_","),$G(VALUE),1)
Q
;
GETVCON(SYSPTR) ;Get value of VUID SERVER CONNECTION TYPE field (#13)
; Input : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : Internal Value ^ External Value
; Notes : If no value found, values for MailMan connection returned
N FAC,ARR,NTRNL,XTRNL
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q "1^MAILMAN"
S XTRNL=$$GET(7118.29,13,(FAC_","),"B",.ARR)
I XTRNL="" Q "1^MAILMAN"
Q ARR("I")_"^"_XTRNL
;
SETVCON(VALUE,SYSPTR) ;Set value of VUID SERVER CONNECTION TYPE field (#13)
; Input : VALUE - New value (internal or external)
; : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : None
N FAC,X
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q
S X=$$SET(7118.29,13,(FAC_","),$G(VALUE),1)
Q
;
GETVSRV(SYSPTR) ;Get value of VUID SERVER OPTION field (#21)
; Input : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : Value of field
; Notes : If no value found, HDIS-FACILITY-DATA-SERVER returned
N FAC,XTRNL
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q "HDIS-FACILITY-DATA-SERVER"
S XTRNL=$$GET(7118.29,21,(FAC_","),"E")
I XTRNL="" Q "HDIS-FACILITY-DATA-SERVER"
Q XTRNL
;
SETVSRV(VALUE,SYSPTR) ;Set value of VUID SERVER OPTION field (#21)
; Input : VALUE - New value (internal or external)
; : SYSPTR - Pointer to HDIS System file
; (default to current system)
;Output : None
N FAC,X
S FAC=$$GETPTR^HDISVF10($G(SYSPTR))
I 'FAC Q
S X=$$SET(7118.29,21,(FAC_","),$G(VALUE),1)
Q
;
;---------- End HDIS PARAMETER file APIs ----------
;
SET(FILE,FIELD,IENS,VALUE,XTRNL) ;Store value into a field
; Input : FILE - File number
; FIELD - Field number
; IENS - IENS of entry
; VALUE - Value to store
; XTRNL - Flag indicating if VALUE is in external format
; 1 = Yes (external) 0 = No (internal) (default)
;Output : Flag indicating if storing of value was done
; 1 = OK 0 = Error
; Notes : Assumes input values are valid and exist
; : Does not support word processing fields
N HDISFDA,HDISMSG,FLAGS
S HDISFDA(FILE,IENS,FIELD)=VALUE
S FLAGS=$S(XTRNL:"E",1:"")
D FILE^DIE(FLAGS,"HDISFDA","HDISMSG")
Q $D(HDISMSG)
;
GET(FILE,FIELD,IENS,HOW,OUTPUT) ;Get value for a field
; Input : FILE - File number
; FIELD - Field number
; IENS - IENS of entry
; HOW - Flag indicating how value should be returned
; I - Return internal value
; E - Return external value
; B - Return internal and external value
; OUTPUT - Output array (pass by reference - dot notation)
; Only set if HOW = B (both)
; OUTPUT("I") = Internal value
; OUTPUT("E") = External value
;Output : If HOW = I, internal value
; If HOW = E, external value
; If HOW = B, external value
; Notes : Assumes input values are valid and exist
; : Does not support word processing fields
; : Null ("") returned on error
N FLAGS,HDISTRG,HDISMSG
S FLAGS=$S(HOW="I":"I",HOW="E":"E",1:"IE")
D GETS^DIQ(FILE,IENS,FIELD,FLAGS,"HDISTRG","HDISMSG")
I $D(HDISMSG) K OUTPUT Q ""
I HOW'="B" Q $G(HDISTRG(FILE,IENS,FIELD,HOW))
S OUTPUT("I")=$G(HDISTRG(FILE,IENS,FIELD,"I"))
S OUTPUT("E")=$G(HDISTRG(FILE,IENS,FIELD,"E"))
Q OUTPUT("E")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVF02 6188 printed Nov 22, 2024@17:06:55 Page 2
HDISVF02 ;BPFO/JRP - FILE UTILITIES/API;12/20/2004
+1 ;;1.0;HEALTH DATA & INFORMATICS;;Feb 22, 2005
+2 ;
+3 ;---------- Begin HDIS PARAMETER file (#7118.29) APIs ----------
+4 ;
GETTYPE(SYSPTR) ;Get value of SYSTEM TYPE field (#.02)
+1 ; Input : SYSPTR - Pointer to HDIS System file
+2 ; (default to current system)
+3 ;Output : Internal Value ^ External Value
+4 ; Notes : If no value found, values for client system type returned
+5 NEW FAC,ARR,NTRNL,XTRNL
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT "1^CLIENT"
+8 SET XTRNL=$$GET(7118.29,.02,(FAC_","),"B",.ARR)
+9 IF XTRNL=""
QUIT "1^CLIENT"
+10 QUIT ARR("I")_"^"_XTRNL
+11 ;
SETTYPE(VALUE,SYSPTR) ;Set value of SYSTEM TYPE field (#.02)
+1 ; Input : VALUE - New value (internal or external)
+2 ; : SYSPTR - Pointer to HDIS System file
+3 ; (default to current system)
+4 ;Output : None
+5 NEW FAC,X,HDIVAL,HDIERR
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT
+8 ;Convert VALUE to internal - allows changing of uneditable field
+9 DO CHK^DIE(7118.29,.02,"",$GET(VALUE),.HDIVAL,"HDIERR")
+10 IF HDIVAL="^"
QUIT
+11 SET X=$$SET(7118.29,.02,(FAC_","),HDIVAL,0)
+12 QUIT
+13 ;
GETVFAIL(SYSPTR) ;Get value of DISABLE VUID ACTIVITY field (#11)
+1 ; Input : SYSPTR - Pointer to HDIS System file
+2 ; (default to current system)
+3 ;Output : Internal Value ^ External Value
+4 ; Notes : If no value found, values for OFF are returned
+5 NEW FAC,ARR,NTRNL,XTRNL
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT "0^OFF"
+8 SET XTRNL=$$GET(7118.29,11,(FAC_","),"B",.ARR)
+9 IF XTRNL=""
QUIT "0^OFF"
+10 QUIT ARR("I")_"^"_XTRNL
+11 ;
SETVFAIL(VALUE,SYSPTR) ;Set value of DISABLE VUID ACTIVITY field (#11)
+1 ; Input : VALUE - New value (internal or external)
+2 ; : SYSPTR - Pointer to HDIS System file
+3 ; (default to current system)
+4 ;Output : None
+5 NEW FAC,X
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT
+8 SET X=$$SET(7118.29,11,(FAC_","),$GET(VALUE),1)
+9 QUIT
+10 ;
GETVLOC(SYSPTR) ;Get value of VUID SERVER LOCATION field (#12)
+1 ; Input : SYSPTR - Pointer to HDIS System file
+2 ; (default to current system)
+3 ;Output : Value of field
+4 ; Notes : If no value found, domain for FORUM returned
+5 NEW FAC,XTRNL
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT "DOMAIN.EXT"
+8 SET XTRNL=$$GET(7118.29,12,(FAC_","),"E")
+9 IF XTRNL=""
QUIT "DOMAIN.EXT"
+10 QUIT XTRNL
+11 ;
SETVLOC(VALUE,SYSPTR) ;Set value of VUID SERVER LOCATION field (#12)
+1 ; Input : VALUE - New value (internal or external)
+2 ; : SYSPTR - Pointer to HDIS System file
+3 ; (default to current system)
+4 ;Output : None
+5 NEW FAC,X
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT
+8 SET X=$$SET(7118.29,12,(FAC_","),$GET(VALUE),1)
+9 QUIT
+10 ;
GETVCON(SYSPTR) ;Get value of VUID SERVER CONNECTION TYPE field (#13)
+1 ; Input : SYSPTR - Pointer to HDIS System file
+2 ; (default to current system)
+3 ;Output : Internal Value ^ External Value
+4 ; Notes : If no value found, values for MailMan connection returned
+5 NEW FAC,ARR,NTRNL,XTRNL
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT "1^MAILMAN"
+8 SET XTRNL=$$GET(7118.29,13,(FAC_","),"B",.ARR)
+9 IF XTRNL=""
QUIT "1^MAILMAN"
+10 QUIT ARR("I")_"^"_XTRNL
+11 ;
SETVCON(VALUE,SYSPTR) ;Set value of VUID SERVER CONNECTION TYPE field (#13)
+1 ; Input : VALUE - New value (internal or external)
+2 ; : SYSPTR - Pointer to HDIS System file
+3 ; (default to current system)
+4 ;Output : None
+5 NEW FAC,X
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT
+8 SET X=$$SET(7118.29,13,(FAC_","),$GET(VALUE),1)
+9 QUIT
+10 ;
GETVSRV(SYSPTR) ;Get value of VUID SERVER OPTION field (#21)
+1 ; Input : SYSPTR - Pointer to HDIS System file
+2 ; (default to current system)
+3 ;Output : Value of field
+4 ; Notes : If no value found, HDIS-FACILITY-DATA-SERVER returned
+5 NEW FAC,XTRNL
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT "HDIS-FACILITY-DATA-SERVER"
+8 SET XTRNL=$$GET(7118.29,21,(FAC_","),"E")
+9 IF XTRNL=""
QUIT "HDIS-FACILITY-DATA-SERVER"
+10 QUIT XTRNL
+11 ;
SETVSRV(VALUE,SYSPTR) ;Set value of VUID SERVER OPTION field (#21)
+1 ; Input : VALUE - New value (internal or external)
+2 ; : SYSPTR - Pointer to HDIS System file
+3 ; (default to current system)
+4 ;Output : None
+5 NEW FAC,X
+6 SET FAC=$$GETPTR^HDISVF10($GET(SYSPTR))
+7 IF 'FAC
QUIT
+8 SET X=$$SET(7118.29,21,(FAC_","),$GET(VALUE),1)
+9 QUIT
+10 ;
+11 ;---------- End HDIS PARAMETER file APIs ----------
+12 ;
SET(FILE,FIELD,IENS,VALUE,XTRNL) ;Store value into a field
+1 ; Input : FILE - File number
+2 ; FIELD - Field number
+3 ; IENS - IENS of entry
+4 ; VALUE - Value to store
+5 ; XTRNL - Flag indicating if VALUE is in external format
+6 ; 1 = Yes (external) 0 = No (internal) (default)
+7 ;Output : Flag indicating if storing of value was done
+8 ; 1 = OK 0 = Error
+9 ; Notes : Assumes input values are valid and exist
+10 ; : Does not support word processing fields
+11 NEW HDISFDA,HDISMSG,FLAGS
+12 SET HDISFDA(FILE,IENS,FIELD)=VALUE
+13 SET FLAGS=$SELECT(XTRNL:"E",1:"")
+14 DO FILE^DIE(FLAGS,"HDISFDA","HDISMSG")
+15 QUIT $DATA(HDISMSG)
+16 ;
GET(FILE,FIELD,IENS,HOW,OUTPUT) ;Get value for a field
+1 ; Input : FILE - File number
+2 ; FIELD - Field number
+3 ; IENS - IENS of entry
+4 ; HOW - Flag indicating how value should be returned
+5 ; I - Return internal value
+6 ; E - Return external value
+7 ; B - Return internal and external value
+8 ; OUTPUT - Output array (pass by reference - dot notation)
+9 ; Only set if HOW = B (both)
+10 ; OUTPUT("I") = Internal value
+11 ; OUTPUT("E") = External value
+12 ;Output : If HOW = I, internal value
+13 ; If HOW = E, external value
+14 ; If HOW = B, external value
+15 ; Notes : Assumes input values are valid and exist
+16 ; : Does not support word processing fields
+17 ; : Null ("") returned on error
+18 NEW FLAGS,HDISTRG,HDISMSG
+19 SET FLAGS=$SELECT(HOW="I":"I",HOW="E":"E",1:"IE")
+20 DO GETS^DIQ(FILE,IENS,FIELD,FLAGS,"HDISTRG","HDISMSG")
+21 IF $DATA(HDISMSG)
KILL OUTPUT
QUIT ""
+22 IF HOW'="B"
QUIT $GET(HDISTRG(FILE,IENS,FIELD,HOW))
+23 SET OUTPUT("I")=$GET(HDISTRG(FILE,IENS,FIELD,"I"))
+24 SET OUTPUT("E")=$GET(HDISTRG(FILE,IENS,FIELD,"E"))
+25 QUIT OUTPUT("E")
