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

INHUTC11.m

Go to the documentation of this file. 
  1. INHUTC11 ;bar; 19 Jun 97 17:29; Internal Functions for Criteria Mgmt 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;;COPYRIGHT 1997 SAIC
  1.  Q
  1.  ;
  1. SAVE(INOPT,INDA,INCTRL) ; save working record to user defined record
  1.  ;
  1.  ; input:   INOPT array. See INHUTCD for description.
  1.  ;          INDA   = entry in criteria file (req)
  1.  ;          INCTRL = S, U, B, or W. control value of saved record (opt)
  1.  ; returns: ien of record in INTERFACE CRITERIA file
  1.  ;          if function does not complete, reason text is returned.
  1.  ;
  1.  Q:'$G(INDA) "SAVE: Entry number not supplied"
  1.  S INCTRL=$S('$L($G(INCTRL)):"U","SUBW"[INCTRL:INCTRL,1:"U")
  1.  N INX,INAME,INOK,INOPT2
  1.  ; get save field value
  1.  S INX=$G(^DIZ(4001.1,INDA,0)),INAME=$P(INX,U,4)
  1.  ; quit if not to be saved
  1.  Q:'$L(INAME) INDA
  1.  ; see if name exists already
  1.  S INOPT2("DUZ")=$P(INX,U,2),INOPT2("TYPE")=$P(INX,U,5),INOPT2("APP")=$P(INX,U,8),INOPT2("FUNC")=$P(INX,U,6),INOPT2("CONTROL")=INCTRL
  1.  S INFROM=$$LOOKUP^INHUTC1(.INOPT2,INAME)
  1.  ; interactive mode, name exists, does not match selected name,
  1.  ; ask to overwrite
  1.  S INOK=1 I '$G(INOPT("NONINTER")),INFROM,INAME'=$P($G(INOPT("SELECTED")),U,2) S INOK=$$YN^UTWRD("Overwrite "_INAME_" with new version? ;0")
  1.  ; return answer
  1.  S INOPT("OVERWRITE")=INOK
  1.  ; and if they say no? remove name and quit
  1.  I 'INOK D  Q INDA
  1.  . N DIC,DIE,DA S DIE=4001.1,DR=".04///@",DA=INDA D ^DIE
  1.  ; if entry does not already exist, create new entry
  1.  S:'INFROM INFROM=$$NEW^INHUTC1(.INOPT,INCTRL)
  1.  ; copy data to record
  1.  D COPY(INDA,INFROM,INCTRL)
  1.  Q INDA
  1.  ;
  1. COPY(INFROM,INTO,INCTRL) ; copy search fields from one entry to another
  1.  ; input:  INFROM = ien to INTERFACE CRITERIA file to copy from. (opt)
  1.  ;                  if 0, will clear contents of INTO 
  1.  ;         INTO   = ien to INTERFACE CRITERIA file to copy to    (req)
  1.  ;         INCTRL = CONTROL field value of "TO" entry (opt)
  1.  ;
  1.  Q:'$G(INTO)  S INFROM=$G(INFROM,0),INCTRL=$G(INCTRL)
  1.  N DIK,DA
  1.  ; delete current x-refs
  1.  S DIK="^DIZ(4001.1,",DA=INTO
  1.  ; VA/IHS FileMan does not have IX2 tag
  1.  I $$SC^INHUTIL1 D IX2^DIK
  1.  ; clear current fields, clear name if no from entry
  1.  S DA=0 F  S DA=$O(^DIZ(4001.1,INTO,DA)) Q:'DA  K ^(DA)
  1.  S $P(^DIZ(4001.1,INTO,0),U,4)=""
  1.  ; move entry
  1.  M:INFROM ^DIZ(4001.1,INTO)=^DIZ(4001.1,INFROM)
  1.  ; update .01 field
  1.  S $P(^DIZ(4001.1,INTO,0),U,1)=INTO
  1.  ; update CONTROL field
  1.  I $L($G(INCTRL)) S $P(^DIZ(4001.1,INTO,0),U,3)=INCTRL
  1.  ; update INTO entry with last access date
  1.  S $P(^DIZ(4001.1,INTO,0),U,9)=$$DT^%ZTFDT
  1.  ; if copied from system record, blank name
  1.  I INFROM,$P(^DIZ(4001.1,INFROM,0),U,3)="S" S $P(^DIZ(4001.1,INTO,0),U,4)=""
  1.  ; reindex this entry
  1.  S DIK="^DIZ(4001.1,",DA=INTO D IX1^DIK
  1.  Q
  1.  ;
  1. EDIT(INDA,INGALL) ; edit criteria entry
  1.  ;
  1.  ; input:   INDA = ien of criteria file entry (req)
  1.  ;          INGALL = gallery name  (req)
  1.  ; returns: ien of criteria entry if no errors
  1.  ;          on error, returns text of error
  1.  ;
  1.  Q:'$G(INDA) "EDIT: Interface Criteria entry not supplied."
  1.  ;  Force ^DWC to ask to file then Preset the fields for another search
  1.  ; removed DWASK="" to not force it bar 02/05/97
  1.  ; For IHS, don't deal with DWC.
  1.  I $$SC^INHUTIL1 S DA=INDA,DWN=INGALL,DIE=4001.1,DWASK="" D ^DWC
  1.  Q:$D(DTOUT)!$D(DUOUT) "EDIT: User aborted gallery edit."
  1.  ; update edited date
  1.  S $P(^DIZ(4001.1,INDA,0),U,9)=$$DT^%ZTFDT
  1.  Q INDA
  1.  ;