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

INHUTC2.m

Go to the documentation of this file. 
  1. INHUTC2 ;bar; 29 May 97 14:50; Interface Criteria Internal Utilities (DD)
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;;COPYRIGHT 1997 SAIC
  1.  Q
  1.  ;
  1. CLRLK(INOPT,INDA) ; clear all accumulated locks
  1.  ;
  1.  ; input:   INOPT array
  1.  ;          INDA = optional entry to not clear
  1.  ; return:  none
  1.  ;
  1.  N H,I,Y
  1.  S Y=0 F  S Y=$O(INOPT("LOCK",Y)) Q:'Y  D
  1.  . S H=INOPT("LOCK",Y)
  1.  . I Y=$G(INDA) S H=H-1,INOPT("LOCK",Y)=1
  1.  . E  K INOPT("LOCK",Y)
  1.  . F I=1:1:H S %=$$LOCK^INHUTC(Y,0)
  1.  Q
  1.  ;
  1. TASK ; this tag is the entry point when called thru taskman
  1.  ; input: INOPT array as described at the top of INHUTC, required.
  1.  S %=$$RUN^INHUTC(.INOPT)
  1.  Q
  1.  ;
  1. AUSER(INDA,INDUZ,INTYPE,INCTRL,INAPP,INFUNC,INDEL) ; manage AUSER x-ref
  1.  ;
  1.  ; input: INDA = ien to 4001.1 file, required
  1.  ;               at least one of the next four is required
  1.  ;        INTYPE = value of CRITERIA TYPE field
  1.  ;        INCTRL = value of CONTROL field
  1.  ;        INAPP = value of APPLICATION field
  1.  ;        INFUNC = value of FUNCTION field
  1.  ;        INDEL = if TRUE kill x-ref, otherwize set x-ref, optional
  1.  ;
  1.  Q:$G(INDA)<1
  1.  N INNULL S INNULL="INNULL"
  1.  I '$G(INDUZ) S INDUZ=$P(^DIZ(4001.1,INDA,0),U,2) S:'INDUZ INDUZ="NULL"
  1.  E  S INNULL="INDUZ"
  1.  I '$L($G(INTYPE)) S INTYPE=$P(^DIZ(4001.1,INDA,0),U,5) S:'$L(INTYPE) INTYPE="NULL"
  1.  E  S INNULL="INTYPE"
  1.  I '$L($G(INCTRL)) S INCTRL=$P(^DIZ(4001.1,INDA,0),U,3) S:'$L(INCTRL) INCTRL="NULL"
  1.  E  S INNULL="INCTRL"
  1.  I '$L($G(INAPP)) S INAPP=$P(^DIZ(4001.1,INDA,0),U,8) S:'$L(INAPP) INAPP="NULL"
  1.  E  S INNULL="INAPP"
  1.  I '$L($G(INFUNC)) S INFUNC=$P(^DIZ(4001.1,INDA,0),U,6) S:'$L(INFUNC) INFUNC="NULL"
  1.  E  S INNULL="INFUNC"
  1.  I $G(INDEL) D  Q
  1.  . K ^DIZ(4001.1,"AUSER",INDUZ,INTYPE,INCTRL,INAPP,INFUNC,INDA)
  1.  . ; W !,"K ^DIZ(4001.1,""AUSER"","_INDUZ_","_INTYPE_","_INCTRL_","_INAPP_","_INFUNC_","_INDA_")"
  1.  D
  1.  . N @INNULL Q:'$D(INNULL)  S @INNULL="NULL"
  1.  . D AUSER(INDA,INDUZ,INTYPE,INCTRL,INAPP,INFUNC,1)
  1.  S ^DIZ(4001.1,"AUSER",INDUZ,INTYPE,INCTRL,INAPP,INFUNC,INDA)=""
  1.  ; W !,"S ^DIZ(4001.1,""AUSER"","_INDUZ_","_INTYPE_","_INCTRL_","_INAPP_","_INFUNC_","_INDA_")="""""
  1.  Q
  1.  ;
  1. TYPE(INTYPE,INSRCH) ; validate CRITERIA TYPE field
  1.  ; called from input transform file 4001.1, field .05
  1.  ; also used in criteria mgmt functions
  1.  ;
  1.  ; input: INTYPE = value to validate
  1.  ;        INSRCH - 0 = validate for any type
  1.  ;                 1 = validate for search types only
  1.  ; return: boolean TRUE or FALSE
  1.  ;
  1.  Q:'$L($G(INTYPE)) 0
  1.  I $G(INSRCH) Q "^TRANSACTION^ERROR^"[(U_INTYPE_U)
  1.  Q "^TRANSACTION^ERROR^TEST^"[(U_INTYPE_U)
  1.  ;
  1. SPACEBAR(X) ; return x for spacebar in lookup
  1.  ; called from PRELK node for file 4001.1, also used in criteria mgmt
  1.  ; functions. INOPT array must be defined in env.
  1.  ;
  1.  ; input:  X = input value from read
  1.  ; returns: `ien or X if working entry was not created
  1.  ;
  1.  I $D(INOPT)<10 Q X
  1.  N INY S INY=$$WORKREC^INHUTC1(.INOPT,0)
  1.  ; kill screen, it won't let "W" go thru
  1.  I INY>0 S INY="`"_INY,DIC("S")="" Q INY
  1.  Q X
  1.  ;
  1. RDTGET ; update a WindowMan Screen while editing, PART 1
  1.  ; assumes being called from WindowMan and those variables are defined
  1.  ; Called before RDTSET to setup the proper values
  1.  ;
  1.  ; get start/end relative date
  1.  S DWDIPA(24.01,"STDTR")="",DWDIPA(24.02,"ENDTR")=""
  1.  ; get aux start/end relative date
  1.  S DWDIPA(24.05,"AUSTDTR")="",DWDIPA(24.06,"AUENDTR")=""
  1.  Q
  1.  ;
  1. RDTSET ; update a WindowMan Screen while editing, PART 2
  1.  ; assumes being called from WindowMan and those variables are defined
  1.  ; RDTGET must be called first and on a separate line in a POST field
  1.  ;
  1.  S:$L($G(DIPA("STDTR"))) DWSFLD(1)=$$RELDT^INHUTC2(DIPA("STDTR"),"PU")
  1.  S:$L($G(DIPA("ENDTR"))) DWSFLD(1.1)=$$RELDT^INHUTC2(DIPA("ENDTR"),"PU")
  1.  S:$L($G(DIPA("AUSTDTR"))) DWSFLD(15.01)=$$RELDT^INHUTC2(DIPA("AUSTDTR"),"PU")
  1.  S:$L($G(DIPA("AUENDTR"))) DWSFLD(15.02)=$$RELDT^INHUTC2(DIPA("AUENDTR"),"PU")
  1.  Q
  1.  ;
  1. RELDATE(INCRITDA) ; update relative date for start and end date
  1.  ;
  1.  Q:'$G(INCRITDA)
  1.  N INS,INE,INAS,INAE
  1.  ; relative date for start and end date
  1.  S INS=$G(^DIZ(4001.1,INCRITDA,24)),INE=$P(INS,U,2),INAS=$P(INS,U,5),INAE=$P(INS,U,6),INS=$P(INS,U,1)
  1.  S:$L(INS) ^DIZ(4001.1,INCRITDA,1)=$$RELDT^INHUTC2(INS)
  1.  S:$L(INE) ^DIZ(4001.1,INCRITDA,1.1)=$$RELDT^INHUTC2(INE)
  1.  ; relative date for aux start and end date
  1.  S:$L(INAS) $P(^DIZ(4001.1,INCRITDA,15),U,1)=$$RELDT^INHUTC2(INAS)
  1.  S:$L(INAE) $P(^DIZ(4001.1,INCRITDA,15),U,2)=$$RELDT^INHUTC2(INAE)
  1.  Q
  1.  ;
  1. RELDT(INSTR,INFMT,INPMT) ; convert a relative date text string to FM
  1.  ;
  1.  ; this entry point is used from the DD which does not contain S and T
  1.  ; Use $$RELDT^INHUTC21 entry point not this entry point
  1.  ;
  1.  S INFMT=$G(INFMT)
  1.  ; allow time in input string
  1.  S:'$F(INFMT,"T") INFMT=INFMT_"T"
  1.  ; allow seconds in input string
  1.  S:'$F(INFMT,"S") INFMT=INFMT_"S"
  1.  Q $$RELDT^INHUTC21($G(INSTR),INFMT,$G(INPMT))