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

INHPSA4.m

Go to the documentation of this file. 
  1. INHPSA4 ; KAC ; 21 Jun 99 13:19; Interface Control Program (continued) 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1.  ;
  1. TTBASE(DA,INST,INHIER) ; $$ function - Deactivate/activate one base (and associated
  1.  ; parent) transaction type based on replicant transaction type (DA).
  1.  ;
  1.  ; Input:
  1.  ; DA = INTERFACE TRANSACTION TYPE IEN for replicant
  1.  ; INST = 0 - deactivate
  1.  ;        1 - activate
  1.  ;        2 - show
  1.  ;
  1.  ; Variables:
  1.  ; INBASEDA - INTERFACE TRANSACTION TYPE IEN for base associated with replicant
  1.  ; INCUSTAT - current status of base TT (0=inactive, 1=active)
  1.  ; INRHRDA  - INTERFACE MESSAGE REPLICATION IEN for replicant
  1.  ; OK       - "OK to deactivate TT" flag
  1.  ; REPTT    - INTERFACE TRANSACTION TYPE IEN for other replicants associated
  1.  ;            with this base TT
  1.  ; RHRTT    - INTERFACE MESSAGE REPLICATION IEN for other entries associated
  1.  ;            with this base TT
  1.  ;
  1.  ; Output:
  1.  ; 1 = successful de/activation
  1.  ; 0 = error
  1.  ;
  1.  N INBASEDA,INCUSTAT,INRHRDA,OK,REPTT,RHRTT
  1.  Q:'$D(^INRHR("B",DA)) 1  ; DA is NOT a Replicant TT
  1.  S INRHRDA=$O(^INRHR("B",DA,0))
  1.  I 'INRHRDA D  Q 0
  1.  .D T^INHMG1 W "ERROR:  Replicant Transaction Type, "_$P($G(^INRHT(+DA,0)),U)
  1.  .D T^INHMG1 W "        not found in INTERFACE MESSAGE REPLICATION file - B Xef missing."
  1.  .D T^INHMG1 W !
  1.  S INBASEDA=$P(^INRHR(INRHRDA,0),U,2)
  1.  I $S('INBASEDA:1,'$D(^INRHT(INBASEDA)):1,1:0) D  Q 0
  1.  .D T^INHMG1 W "ERROR:  Base Transaction Type not found in INTERFACE MESSAGE REPLICATION"
  1.  .D T^INHMG1 W "        file for Replicant Transaction Type, "_$P($G(^INRHT(+DA,0)),U)_"."
  1.  .D T^INHMG1 W !
  1.  ;
  1.  S INCUSTAT=$P(^INRHT(INBASEDA,0),U,5) ; get current status of base TT
  1.  ;
  1.  ; Perform activation process
  1.  I INST=1 D:'INCUSTAT
  1.  .; Base is NOT active - check for active replicants
  1.  .S RHRTT="" F  S RHRTT=$O(^INRHR("AC",INBASEDA,RHRTT)) Q:'RHRTT  S REPTT=+$P(^INRHR(RHRTT,0),U) D
  1.  ..; no warning if REPTT is calling replicant or is inactive
  1.  ..Q:(REPTT=DA)!('$P($G(^INRHT(REPTT,0)),U,5))
  1.  ..D T^INHMG1 W "WARNING:  Transaction type ",$P(^INRHT(REPTT,0),U)," was active.  "
  1.  ..D T^INHMG1 W "          Messages will now be generated for this transaction type."
  1.  ;
  1.  ; Perform deactivation process
  1.  I 'INST S OK=1 D:INCUSTAT  Q:'OK 1  ; exit if NOT OK to deactivate base & parent
  1.  .; Base is active - check for active replicants
  1.  .; no deactivation if REPTT is NOT the calling replicant & is active
  1.  .S RHRTT="" F  S RHRTT=$O(^INRHR("AC",INBASEDA,RHRTT)) Q:'RHRTT  S REPTT=+$P(^INRHR(RHRTT,0),U) I REPTT'=DA,$P($G(^INRHT(REPTT,0)),U,5) S OK=0 Q
  1.  ;
  1.  ; De/Activate Base TT
  1.  Q:'$$TTEDT^INHPSA(INBASEDA,INST,.INHIER,"BASE") 0
  1.  ;
  1.  ; De/Activate associated Parent TT
  1.  Q:'$$TTPAR^INHPSA(INBASEDA,INST,.INHIER) 0
  1.  ;
  1.  Q 1
  1.  ;-----------------
  1. WRITE(INHIER,INST) ; write the transaction type, parent, base and child
  1.  ;Input:
  1.  ; INST   = 0 - deactivate
  1.  ;          1 - activate
  1.  ;          2 - show
  1.  ;
  1.  ; INHIER -  array where
  1.  ;    INHIER("PARENT") = INTERFACE TRANSACTION TYPE IEN for parent
  1.  ;    INHIER("BASE")   = INTERFACE TRANSACTION TYPE IEN for base
  1.  ;    INHIER("CHILD")  = INTERFACE TRANSACTION TYPE IEN for child
  1.  ;
  1.  N P,B,C,INMRG
  1.  S P=$G(INHIER("PARENT"))
  1.  S B=$G(INHIER("BASE"))
  1.  S C=$G(INHIER("CHILD"))
  1.  I $P($G(^INRHT(+C,0)),U,8)'="I" D
  1.  .S INMRG=0
  1.  .I P D T^INHMG1 Q:$G(DUOUT)  W "Parent: ",$P($G(^INRHT(+P,0)),U),?68,$$GACT(+P,INST) S INMRG=INMRG+3
  1.  .I B D T^INHMG1 Q:$G(DUOUT)  W ?INMRG,"Base:   ",$P($G(^INRHT(+B,0)),U),?68,$$GACT(+B,INST) S INMRG=INMRG+3
  1.  .D T^INHMG1 Q:$G(DUOUT)
  1.  .I P&B W ?INMRG,"Rep - TT:  "
  1.  .E  W ?INMRG,$S(P:"Child:  ",1:"Trans:  ")
  1.  .W $P($G(^INRHT(+C,0)),U),?68,$$GACT(+C,INST)
  1.  .D T^INHMG1 Q:$G(DUOUT)  W ?22,"Destination: ",$P($G(^INRHD(+$P($G(^INRHT(+C,0)),U,2),0)),U)
  1.  E  D
  1.  .D T^INHMG1 Q:$G(DUOUT)
  1.  .W "IN - TT: ",$S('C:"NONE",1:$P($G(^INRHT(+C,0)),U)),?68,$$GACT(+C,INST)
  1.  D T^INHMG1 Q:$G(DUOUT)  W !
  1.  Q
  1.  ;
  1. GACT(DA,INST) ; returns the verbos status of the transaction
  1.  ;Input:
  1.  ; DA     = INTERFACE TRANSACTION TYPE IEN
  1.  ; INST   = 0 - deactivate
  1.  ;          1 - activate
  1.  ;          2 - show
  1.  ;Output:
  1.  ;  returns the verbos status of the transaction
  1.  ;
  1.  N ISACT,INSTMSG
  1.  I 'DA Q ""
  1.  S ISACT=$P($G(^INRHT(DA,0)),U,5)
  1.  I INST>1 S INSTMSG=$S('ISACT:"INACTIVE",1:"ACTIVE")
  1.  E  S INSTMSG=$S('ISACT:"DEACTIVATED",1:"ACTIVATED")
  1.  Q INSTMSG
  1.  ;
  1. DISCREP(ININT,INDAT) ;report this disrepancies
  1.  ; Input:
  1.  ;   ININT - interface application to activate
  1.  ;   INDAT = data array of control file records fo application
  1.  ;
  1.  ;  Note:  For a future enhancement, you may want to add more than
  1.  ;         one destination ( entries in file# 4005) to the INHPSA1,
  1.  ;   INHPSA3 and INHPSA5 tables,  Then make the INNAME, 
  1.  ;         INDES arrays, with subscripts containing these destinations.
  1.  ;         Doing this prevent the program from generating bugus, 
  1.  ;         report for interfaces like CRSPL or CRPSR that has 
  1.  ;         more than one destination.
  1.  N INNAME
  1.  N INREC,TTNMA,INARR,FOUND,X
  1.  S INNAME=$G(INDAT(ININT,4005,1))
  1.  D T^INHMG1 Q:$G(DUOUT)
  1.  S X="Discrepancies Report for "_INNAME
  1.  W ?(IOM-$L(X))\2,X
  1.  S Y="" S $P(Y,"*",$L(X)+1)=""
  1.  D T^INHMG1 Q:$G(DUOUT)
  1.  W ?(IOM-$L(X))\2,Y
  1.  I INNAME="" D T^INHMG1 Q:$G(DUOUT)  W "ERROR: No destination found in "_ININT Q
  1.  S INDES=+$O(^INRHD("B",$$UPCASE^%ZTF(INNAME),0))
  1.  I 'INDES D T^INHMG1 Q:$G(DUOUT)  W "ERROR: "_INNAME_" not found in interface destination file" Q
  1.  S INREC=0
  1.  F  S INREC=$O(INDAT(ININT,4000,INREC)) Q:'INREC!$G(DUOUT)  D
  1.  .S TTNAM=$P(INDAT(ININT,4000,INREC),U)
  1.  .Q:TTNAM=""
  1.  .S INTTIEN=$O(^INRHT("B",TTNAM,0))
  1.  .I 'INTTIEN D T^INHMG1 W "ERROR: "_TTNAM_" not found in Interface Transaction file" Q
  1.  .Q:$P($G(^INRHT(INTTIEN,0)),U,8)="I"
  1.  .I $P($G(^INRHT(INTTIEN,0)),U,2)'=INDES D  Q
  1.  ..D T^INHMG1 W "WARNING: "_TTNAM_" has destination  "
  1.  ..D T^INHMG1 W "         "_$P($G(^INRHD(+$P($G(^INRHT(INTTIEN,0)),U,2),0)),U)
  1.  ..;--D T^INHMG1 W "       Interface Destination file is not "_INNAME
  1.  .S INARR(TTNAM,"PRG")=INTTIEN
  1.  Q:$G(DUOUT)
  1.  ;
  1.  S INTTIEN=0
  1.  F  S INTTIEN=$O(^INRHT(INTTIEN)) Q:'INTTIEN  D
  1.  .Q:$P($G(^INRHT(INTTIEN,0)),U,8)="I"
  1.  .Q:$P($G(^INRHT(INTTIEN,0)),U,2)'=INDES
  1.  .S TTNAM=$P($G(^INRHT(INTTIEN,0)),U)
  1.  .S INARR(TTNAM,"FM")=INTTIEN
  1.  ;W !
  1.  ;ZW INARR
  1.  ;W !
  1.  D T^INHMG1 Q:$G(DUOUT)  W !
  1.  S FOUND=0
  1.  D T^INHMG1 Q:$G(DUOUT)  W !
  1.  D T^INHMG1 Q:$G(DUOUT)  W "List of transactions that point to destination: "_INNAME_"."
  1.  D T^INHMG1 Q:$G(DUOUT)  W "But, are not activated/deactivated in EN^INHPSAM"
  1.  S FOUND=0
  1.  S TTNAM=""
  1.  F  S TTNAM=$O(INARR(TTNAM)) Q:$G(TTNAM)=""!$G(DUOUT)  D
  1.  .I $D(INARR(TTNAM,"FM")),'$D(INARR(TTNAM,"PRG")) D
  1.  ..D T^INHMG1 W ?4,TTNAM S FOUND=1
  1.  I 'FOUND D T^INHMG1 W "    **** No transaction found *****"
  1.  Q