MHVU2 ;WAS/GPM - UTILITIES ; 7/25/05 3:48pm [4/30/08 6:29pm]
;;1.0;My HealtheVet;**2,5**;Aug 23, 2005;Build 24
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
TOGGLE(EXTRACT,VAL,ERR) ; Enable or disable the EXTRACT passed by setting the
; value of the BLOCKED field (.03) in MHV REQUEST TYPE file (2275.3)
; to NO or YES respectively.
;
; Input: EXTRACT - String name of the extract
; Example: "CHEMISTRY"
; VAL - "ENABLE" or "DISABLE"
;
; Output: ERR - Error Text
;
N IEN,IENS,FDA
K ERR
S ERR=""
I EXTRACT="" S ERR="EXTRACT PARAMETER NULL" Q 0
S VAL=$S(VAL="ENABLE":0,VAL="DISABLE":1,1:"")
I VAL="" S ERR="VALUE PARAMETER INVALID"_VAL Q 0
;
S IEN=$$FIND1^DIC(2275.3,"","KX",EXTRACT,"B","","ERR")
I 'IEN D Q 0
. I '$G(ERR("DIERR")) S ERR("DIERR",1,"TEXT",1)="NOT FOUND"
. S ERR=$G(ERR("DIERR",1))_"^"_$G(ERR("DIERR",1,"TEXT",1))
. Q
;
K ERR
S ERR=""
S IENS=IEN_","
S FDA(2275.3,IENS,.03)=VAL
D UPDATE^DIE("","FDA","","ERR")
I $G(ERR("DIERR")) S ERR=$G(ERR("DIERR",1))_"^"_$G(ERR("DIERR",1,"TEXT",1)) Q 0
;
Q 1
;
UPDMAP(FIELDS,NEW,ERR) ; Update entries in the MHV RESPONSE MAP file (2275.4)
;
; Input: FIELDS - Array of Field Values
; FIELDS("SUBSCRIBER") - Name of subscriber protocol
; FIELDS("PROTOCOL") - Name of event driver protocol
; FIELDS("BUILDER") - Name of response builder routine
; FIELDS("SEGMENT") - Name of boundary segment
; NEW - 0 to edit, 1 to create new entry
;
; Output: ERR - Error Text
;
N IEN,NAME,PROTOCOL,BUILDER,SEGMENT,FDA
K ERR
S ERR=""
S NAME=$G(FIELDS("SUBSCRIBER"))
S PROTOCOL=$G(FIELDS("PROTOCOL"))
S BUILDER=$G(FIELDS("BUILDER"))
S SEGMENT=$G(FIELDS("SEGMENT"))
I NAME="" S ERR="Missing Subscriber Protocol" Q 0
I PROTOCOL="" S ERR="Missing Response Protocol" Q 0
I BUILDER="" S ERR="Missing Builder Routine" Q 0
;
; Check if entry exists, use it if it does
S IEN=$O(^MHV(2275.4,"B",NAME,0))
I NEW,'IEN S IEN="+1"
I 'NEW,'IEN S ERR="Subscriber Not Defined" Q 0
S IEN=IEN_","
;
S FDA(2275.4,IEN,.01)=NAME
S FDA(2275.4,IEN,.02)=PROTOCOL
S FDA(2275.4,IEN,.03)=BUILDER
S FDA(2275.4,IEN,.04)=SEGMENT
D UPDATE^DIE("E","FDA","","ERR")
I $D(ERR("DIERR")) S ERR=$G(ERR("DIERR",1,"TEXT",1)) Q 0
Q 1
;
UPDREQ(FIELDS,NEW,ERR) ; Update entries in the MHV REQUEST TYPE file (2275.3)
;
; Input: FIELDS - Array of Field Values
; FIELDS("REQUEST TYPE") - Request Type
; FIELDS("NUMBER") - Internal Request Number
; FIELDS("BLOCK") - 0,1 Disable Request
; FIELDS("REALTIME") - Enable Synchronous Response
; FIELDS("EXECUTE") - Name of execute\extract routine
; FIELDS("BUILDER") - Name of response builder routine
; FIELDS("DATATYPE") - External Name for Request Type
; FIELDS("DESCRIPTION") - WP formatted array
; NEW - 0 to edit, 1 to create new entry
;
; Output: ERR - Error Text
;
N IEN,NAME,NUMBER,BLOCK,REALTIME,EXECUTE,BUILDER,DATATYPE,DESC,FDA
K ERR
S ERR=""
S NAME=$G(FIELDS("REQUEST TYPE"))
S NUMBER=$G(FIELDS("NUMBER"))
S BLOCK=$G(FIELDS("BLOCK"))
S REALTIME=$G(FIELDS("REALTIME"))
S EXECUTE=$G(FIELDS("EXECUTE"))
S BUILDER=$G(FIELDS("BUILDER"))
S DATATYPE=$G(FIELDS("DATATYPE"))
M DESC=FIELDS("DESCRIPTION")
I NAME="" S ERR="Missing Request Type" Q 0
I NEW D Q:ERR'="" 0
. I NUMBER="" S ERR="Missing Type Number" Q
. I BLOCK="" S ERR="Missing Blocked Setting" Q
. I REALTIME="" S ERR="Missing RealTime Setting" Q
. I EXECUTE="" S ERR="Missing Execute Routine" Q
. I DATATYPE="" S ERR="Missing Data Type" Q
. I '$D(DESC) S ERR="Missing Description" Q
. Q
;
; Check if entry exists, use it if it does
S IEN=$O(^MHV(2275.3,"B",NAME,0))
I NEW,'IEN S IEN="+1"
I 'NEW,'IEN S ERR="Request Type Not Defined" Q 0
I DATATYPE'="",$D(^MHV(2275.3,IEN,1,"B",DATATYPE)) S DATATYPE=""
S IEN=IEN_","
;
S FDA(2275.3,IEN,.01)=NAME
S:NUMBER'="" FDA(2275.3,IEN,.02)=NUMBER
S:BLOCK'="" FDA(2275.3,IEN,.03)=BLOCK
S:REALTIME'="" FDA(2275.3,IEN,.04)=REALTIME
S:EXECUTE'="" FDA(2275.3,IEN,.05)=EXECUTE
S:BUILDER'="" FDA(2275.3,IEN,.06)=BUILDER
S:DATATYPE'="" FDA(2275.31,"+2,"_IEN,.01)=DATATYPE
S:$D(DESC) FDA(2275.3,IEN,2)="DESC"
D UPDATE^DIE("E","FDA","","ERR")
I $D(ERR("DIERR")) S ERR=$G(ERR("DIERR",1,"TEXT",1)) Q 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHVU2 4532 printed Dec 13, 2024@02:16:08 Page 2
MHVU2 ;WAS/GPM - UTILITIES ; 7/25/05 3:48pm [4/30/08 6:29pm]
+1 ;;1.0;My HealtheVet;**2,5**;Aug 23, 2005;Build 24
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
TOGGLE(EXTRACT,VAL,ERR) ; Enable or disable the EXTRACT passed by setting the
+1 ; value of the BLOCKED field (.03) in MHV REQUEST TYPE file (2275.3)
+2 ; to NO or YES respectively.
+3 ;
+4 ; Input: EXTRACT - String name of the extract
+5 ; Example: "CHEMISTRY"
+6 ; VAL - "ENABLE" or "DISABLE"
+7 ;
+8 ; Output: ERR - Error Text
+9 ;
+10 NEW IEN,IENS,FDA
+11 KILL ERR
+12 SET ERR=""
+13 IF EXTRACT=""
SET ERR="EXTRACT PARAMETER NULL"
QUIT 0
+14 SET VAL=$SELECT(VAL="ENABLE":0,VAL="DISABLE":1,1:"")
+15 IF VAL=""
SET ERR="VALUE PARAMETER INVALID"_VAL
QUIT 0
+16 ;
+17 SET IEN=$$FIND1^DIC(2275.3,"","KX",EXTRACT,"B","","ERR")
+18 IF 'IEN
Begin DoDot:1
+19 IF '$GET(ERR("DIERR"))
SET ERR("DIERR",1,"TEXT",1)="NOT FOUND"
+20 SET ERR=$GET(ERR("DIERR",1))_"^"_$GET(ERR("DIERR",1,"TEXT",1))
+21 QUIT
End DoDot:1
QUIT 0
+22 ;
+23 KILL ERR
+24 SET ERR=""
+25 SET IENS=IEN_","
+26 SET FDA(2275.3,IENS,.03)=VAL
+27 DO UPDATE^DIE("","FDA","","ERR")
+28 IF $GET(ERR("DIERR"))
SET ERR=$GET(ERR("DIERR",1))_"^"_$GET(ERR("DIERR",1,"TEXT",1))
QUIT 0
+29 ;
+30 QUIT 1
+31 ;
UPDMAP(FIELDS,NEW,ERR) ; Update entries in the MHV RESPONSE MAP file (2275.4)
+1 ;
+2 ; Input: FIELDS - Array of Field Values
+3 ; FIELDS("SUBSCRIBER") - Name of subscriber protocol
+4 ; FIELDS("PROTOCOL") - Name of event driver protocol
+5 ; FIELDS("BUILDER") - Name of response builder routine
+6 ; FIELDS("SEGMENT") - Name of boundary segment
+7 ; NEW - 0 to edit, 1 to create new entry
+8 ;
+9 ; Output: ERR - Error Text
+10 ;
+11 NEW IEN,NAME,PROTOCOL,BUILDER,SEGMENT,FDA
+12 KILL ERR
+13 SET ERR=""
+14 SET NAME=$GET(FIELDS("SUBSCRIBER"))
+15 SET PROTOCOL=$GET(FIELDS("PROTOCOL"))
+16 SET BUILDER=$GET(FIELDS("BUILDER"))
+17 SET SEGMENT=$GET(FIELDS("SEGMENT"))
+18 IF NAME=""
SET ERR="Missing Subscriber Protocol"
QUIT 0
+19 IF PROTOCOL=""
SET ERR="Missing Response Protocol"
QUIT 0
+20 IF BUILDER=""
SET ERR="Missing Builder Routine"
QUIT 0
+21 ;
+22 ; Check if entry exists, use it if it does
+23 SET IEN=$ORDER(^MHV(2275.4,"B",NAME,0))
+24 IF NEW
IF 'IEN
SET IEN="+1"
+25 IF 'NEW
IF 'IEN
SET ERR="Subscriber Not Defined"
QUIT 0
+26 SET IEN=IEN_","
+27 ;
+28 SET FDA(2275.4,IEN,.01)=NAME
+29 SET FDA(2275.4,IEN,.02)=PROTOCOL
+30 SET FDA(2275.4,IEN,.03)=BUILDER
+31 SET FDA(2275.4,IEN,.04)=SEGMENT
+32 DO UPDATE^DIE("E","FDA","","ERR")
+33 IF $DATA(ERR("DIERR"))
SET ERR=$GET(ERR("DIERR",1,"TEXT",1))
QUIT 0
+34 QUIT 1
+35 ;
UPDREQ(FIELDS,NEW,ERR) ; Update entries in the MHV REQUEST TYPE file (2275.3)
+1 ;
+2 ; Input: FIELDS - Array of Field Values
+3 ; FIELDS("REQUEST TYPE") - Request Type
+4 ; FIELDS("NUMBER") - Internal Request Number
+5 ; FIELDS("BLOCK") - 0,1 Disable Request
+6 ; FIELDS("REALTIME") - Enable Synchronous Response
+7 ; FIELDS("EXECUTE") - Name of execute\extract routine
+8 ; FIELDS("BUILDER") - Name of response builder routine
+9 ; FIELDS("DATATYPE") - External Name for Request Type
+10 ; FIELDS("DESCRIPTION") - WP formatted array
+11 ; NEW - 0 to edit, 1 to create new entry
+12 ;
+13 ; Output: ERR - Error Text
+14 ;
+15 NEW IEN,NAME,NUMBER,BLOCK,REALTIME,EXECUTE,BUILDER,DATATYPE,DESC,FDA
+16 KILL ERR
+17 SET ERR=""
+18 SET NAME=$GET(FIELDS("REQUEST TYPE"))
+19 SET NUMBER=$GET(FIELDS("NUMBER"))
+20 SET BLOCK=$GET(FIELDS("BLOCK"))
+21 SET REALTIME=$GET(FIELDS("REALTIME"))
+22 SET EXECUTE=$GET(FIELDS("EXECUTE"))
+23 SET BUILDER=$GET(FIELDS("BUILDER"))
+24 SET DATATYPE=$GET(FIELDS("DATATYPE"))
+25 MERGE DESC=FIELDS("DESCRIPTION")
+26 IF NAME=""
SET ERR="Missing Request Type"
QUIT 0
+27 IF NEW
Begin DoDot:1
+28 IF NUMBER=""
SET ERR="Missing Type Number"
QUIT
+29 IF BLOCK=""
SET ERR="Missing Blocked Setting"
QUIT
+30 IF REALTIME=""
SET ERR="Missing RealTime Setting"
QUIT
+31 IF EXECUTE=""
SET ERR="Missing Execute Routine"
QUIT
+32 IF DATATYPE=""
SET ERR="Missing Data Type"
QUIT
+33 IF '$DATA(DESC)
SET ERR="Missing Description"
QUIT
+34 QUIT
End DoDot:1
if ERR'=""
QUIT 0
+35 ;
+36 ; Check if entry exists, use it if it does
+37 SET IEN=$ORDER(^MHV(2275.3,"B",NAME,0))
+38 IF NEW
IF 'IEN
SET IEN="+1"
+39 IF 'NEW
IF 'IEN
SET ERR="Request Type Not Defined"
QUIT 0
+40 IF DATATYPE'=""
IF $DATA(^MHV(2275.3,IEN,1,"B",DATATYPE))
SET DATATYPE=""
+41 SET IEN=IEN_","
+42 ;
+43 SET FDA(2275.3,IEN,.01)=NAME
+44 if NUMBER'=""
SET FDA(2275.3,IEN,.02)=NUMBER
+45 if BLOCK'=""
SET FDA(2275.3,IEN,.03)=BLOCK
+46 if REALTIME'=""
SET FDA(2275.3,IEN,.04)=REALTIME
+47 if EXECUTE'=""
SET FDA(2275.3,IEN,.05)=EXECUTE
+48 if BUILDER'=""
SET FDA(2275.3,IEN,.06)=BUILDER
+49 if DATATYPE'=""
SET FDA(2275.31,"+2,"_IEN,.01)=DATATYPE
+50 if $DATA(DESC)
SET FDA(2275.3,IEN,2)="DESC"
+51 DO UPDATE^DIE("E","FDA","","ERR")
+52 IF $DATA(ERR("DIERR"))
SET ERR=$GET(ERR("DIERR",1,"TEXT",1))
QUIT 0
+53 QUIT 1
+54 ;
