INHPSA4 ; KAC ; 21 Jun 99 13:19; Interface Control Program (continued)
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
Q
;
TTBASE(DA,INST,INHIER) ; $$ function - Deactivate/activate one base (and associated
; parent) transaction type based on replicant transaction type (DA).
;
; Input:
; DA = INTERFACE TRANSACTION TYPE IEN for replicant
; INST = 0 - deactivate
; 1 - activate
; 2 - show
;
; Variables:
; INBASEDA - INTERFACE TRANSACTION TYPE IEN for base associated with replicant
; INCUSTAT - current status of base TT (0=inactive, 1=active)
; INRHRDA - INTERFACE MESSAGE REPLICATION IEN for replicant
; OK - "OK to deactivate TT" flag
; REPTT - INTERFACE TRANSACTION TYPE IEN for other replicants associated
; with this base TT
; RHRTT - INTERFACE MESSAGE REPLICATION IEN for other entries associated
; with this base TT
;
; Output:
; 1 = successful de/activation
; 0 = error
;
N INBASEDA,INCUSTAT,INRHRDA,OK,REPTT,RHRTT
Q:'$D(^INRHR("B",DA)) 1 ; DA is NOT a Replicant TT
S INRHRDA=$O(^INRHR("B",DA,0))
I 'INRHRDA D Q 0
.D T^INHMG1 W "ERROR: Replicant Transaction Type, "_$P($G(^INRHT(+DA,0)),U)
.D T^INHMG1 W " not found in INTERFACE MESSAGE REPLICATION file - B Xef missing."
.D T^INHMG1 W !
S INBASEDA=$P(^INRHR(INRHRDA,0),U,2)
I $S('INBASEDA:1,'$D(^INRHT(INBASEDA)):1,1:0) D Q 0
.D T^INHMG1 W "ERROR: Base Transaction Type not found in INTERFACE MESSAGE REPLICATION"
.D T^INHMG1 W " file for Replicant Transaction Type, "_$P($G(^INRHT(+DA,0)),U)_"."
.D T^INHMG1 W !
;
S INCUSTAT=$P(^INRHT(INBASEDA,0),U,5) ; get current status of base TT
;
; Perform activation process
I INST=1 D:'INCUSTAT
.; Base is NOT active - check for active replicants
.S RHRTT="" F S RHRTT=$O(^INRHR("AC",INBASEDA,RHRTT)) Q:'RHRTT S REPTT=+$P(^INRHR(RHRTT,0),U) D
..; no warning if REPTT is calling replicant or is inactive
..Q:(REPTT=DA)!('$P($G(^INRHT(REPTT,0)),U,5))
..D T^INHMG1 W "WARNING: Transaction type ",$P(^INRHT(REPTT,0),U)," was active. "
..D T^INHMG1 W " Messages will now be generated for this transaction type."
;
; Perform deactivation process
I 'INST S OK=1 D:INCUSTAT Q:'OK 1 ; exit if NOT OK to deactivate base & parent
.; Base is active - check for active replicants
.; no deactivation if REPTT is NOT the calling replicant & is active
.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
;
; De/Activate Base TT
Q:'$$TTEDT^INHPSA(INBASEDA,INST,.INHIER,"BASE") 0
;
; De/Activate associated Parent TT
Q:'$$TTPAR^INHPSA(INBASEDA,INST,.INHIER) 0
;
Q 1
;-----------------
WRITE(INHIER,INST) ; write the transaction type, parent, base and child
;Input:
; INST = 0 - deactivate
; 1 - activate
; 2 - show
;
; INHIER - array where
; INHIER("PARENT") = INTERFACE TRANSACTION TYPE IEN for parent
; INHIER("BASE") = INTERFACE TRANSACTION TYPE IEN for base
; INHIER("CHILD") = INTERFACE TRANSACTION TYPE IEN for child
;
N P,B,C,INMRG
S P=$G(INHIER("PARENT"))
S B=$G(INHIER("BASE"))
S C=$G(INHIER("CHILD"))
I $P($G(^INRHT(+C,0)),U,8)'="I" D
.S INMRG=0
.I P D T^INHMG1 Q:$G(DUOUT) W "Parent: ",$P($G(^INRHT(+P,0)),U),?68,$$GACT(+P,INST) S INMRG=INMRG+3
.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
.D T^INHMG1 Q:$G(DUOUT)
.I P&B W ?INMRG,"Rep - TT: "
.E W ?INMRG,$S(P:"Child: ",1:"Trans: ")
.W $P($G(^INRHT(+C,0)),U),?68,$$GACT(+C,INST)
.D T^INHMG1 Q:$G(DUOUT) W ?22,"Destination: ",$P($G(^INRHD(+$P($G(^INRHT(+C,0)),U,2),0)),U)
E D
.D T^INHMG1 Q:$G(DUOUT)
.W "IN - TT: ",$S('C:"NONE",1:$P($G(^INRHT(+C,0)),U)),?68,$$GACT(+C,INST)
D T^INHMG1 Q:$G(DUOUT) W !
Q
;
GACT(DA,INST) ; returns the verbos status of the transaction
;Input:
; DA = INTERFACE TRANSACTION TYPE IEN
; INST = 0 - deactivate
; 1 - activate
; 2 - show
;Output:
; returns the verbos status of the transaction
;
N ISACT,INSTMSG
I 'DA Q ""
S ISACT=$P($G(^INRHT(DA,0)),U,5)
I INST>1 S INSTMSG=$S('ISACT:"INACTIVE",1:"ACTIVE")
E S INSTMSG=$S('ISACT:"DEACTIVATED",1:"ACTIVATED")
Q INSTMSG
;
DISCREP(ININT,INDAT) ;report this disrepancies
; Input:
; ININT - interface application to activate
; INDAT = data array of control file records fo application
;
; Note: For a future enhancement, you may want to add more than
; one destination ( entries in file# 4005) to the INHPSA1,
; INHPSA3 and INHPSA5 tables, Then make the INNAME,
; INDES arrays, with subscripts containing these destinations.
; Doing this prevent the program from generating bugus,
; report for interfaces like CRSPL or CRPSR that has
; more than one destination.
N INNAME
N INREC,TTNMA,INARR,FOUND,X
S INNAME=$G(INDAT(ININT,4005,1))
D T^INHMG1 Q:$G(DUOUT)
S X="Discrepancies Report for "_INNAME
W ?(IOM-$L(X))\2,X
S Y="" S $P(Y,"*",$L(X)+1)=""
D T^INHMG1 Q:$G(DUOUT)
W ?(IOM-$L(X))\2,Y
I INNAME="" D T^INHMG1 Q:$G(DUOUT) W "ERROR: No destination found in "_ININT Q
S INDES=+$O(^INRHD("B",$$UPCASE^%ZTF(INNAME),0))
I 'INDES D T^INHMG1 Q:$G(DUOUT) W "ERROR: "_INNAME_" not found in interface destination file" Q
S INREC=0
F S INREC=$O(INDAT(ININT,4000,INREC)) Q:'INREC!$G(DUOUT) D
.S TTNAM=$P(INDAT(ININT,4000,INREC),U)
.Q:TTNAM=""
.S INTTIEN=$O(^INRHT("B",TTNAM,0))
.I 'INTTIEN D T^INHMG1 W "ERROR: "_TTNAM_" not found in Interface Transaction file" Q
.Q:$P($G(^INRHT(INTTIEN,0)),U,8)="I"
.I $P($G(^INRHT(INTTIEN,0)),U,2)'=INDES D Q
..D T^INHMG1 W "WARNING: "_TTNAM_" has destination "
..D T^INHMG1 W " "_$P($G(^INRHD(+$P($G(^INRHT(INTTIEN,0)),U,2),0)),U)
..;--D T^INHMG1 W " Interface Destination file is not "_INNAME
.S INARR(TTNAM,"PRG")=INTTIEN
Q:$G(DUOUT)
;
S INTTIEN=0
F S INTTIEN=$O(^INRHT(INTTIEN)) Q:'INTTIEN D
.Q:$P($G(^INRHT(INTTIEN,0)),U,8)="I"
.Q:$P($G(^INRHT(INTTIEN,0)),U,2)'=INDES
.S TTNAM=$P($G(^INRHT(INTTIEN,0)),U)
.S INARR(TTNAM,"FM")=INTTIEN
;W !
;ZW INARR
;W !
D T^INHMG1 Q:$G(DUOUT) W !
S FOUND=0
D T^INHMG1 Q:$G(DUOUT) W !
D T^INHMG1 Q:$G(DUOUT) W "List of transactions that point to destination: "_INNAME_"."
D T^INHMG1 Q:$G(DUOUT) W "But, are not activated/deactivated in EN^INHPSAM"
S FOUND=0
S TTNAM=""
F S TTNAM=$O(INARR(TTNAM)) Q:$G(TTNAM)=""!$G(DUOUT) D
.I $D(INARR(TTNAM,"FM")),'$D(INARR(TTNAM,"PRG")) D
..D T^INHMG1 W ?4,TTNAM S FOUND=1
I 'FOUND D T^INHMG1 W " **** No transaction found *****"
Q
INHPSA4 ; KAC ; 21 Jun 99 13:19; Interface Control Program (continued)
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 QUIT
+5 ;
TTBASE(DA,INST,INHIER) ; $$ function - Deactivate/activate one base (and associated
+1 ; parent) transaction type based on replicant transaction type (DA).
+2 ;
+3 ; Input:
+4 ; DA = INTERFACE TRANSACTION TYPE IEN for replicant
+5 ; INST = 0 - deactivate
+6 ; 1 - activate
+7 ; 2 - show
+8 ;
+9 ; Variables:
+10 ; INBASEDA - INTERFACE TRANSACTION TYPE IEN for base associated with replicant
+11 ; INCUSTAT - current status of base TT (0=inactive, 1=active)
+12 ; INRHRDA - INTERFACE MESSAGE REPLICATION IEN for replicant
+13 ; OK - "OK to deactivate TT" flag
+14 ; REPTT - INTERFACE TRANSACTION TYPE IEN for other replicants associated
+15 ; with this base TT
+16 ; RHRTT - INTERFACE MESSAGE REPLICATION IEN for other entries associated
+17 ; with this base TT
+18 ;
+19 ; Output:
+20 ; 1 = successful de/activation
+21 ; 0 = error
+22 ;
+23 NEW INBASEDA,INCUSTAT,INRHRDA,OK,REPTT,RHRTT
+24 ; DA is NOT a Replicant TT
IF '$DATA(^INRHR("B",DA))
QUIT 1
+25 SET INRHRDA=$ORDER(^INRHR("B",DA,0))
+26 IF 'INRHRDA
Begin DoDot:1
+27 DO T^INHMG1
WRITE "ERROR: Replicant Transaction Type, "_$PIECE($GET(^INRHT(+DA,0)),U)
+28 DO T^INHMG1
WRITE " not found in INTERFACE MESSAGE REPLICATION file - B Xef missing."
+29 DO T^INHMG1
WRITE !
End DoDot:1
QUIT 0
+30 SET INBASEDA=$PIECE(^INRHR(INRHRDA,0),U,2)
+31 IF $SELECT('INBASEDA:1,'$DATA(^INRHT(INBASEDA)):1,1:0)
Begin DoDot:1
+32 DO T^INHMG1
WRITE "ERROR: Base Transaction Type not found in INTERFACE MESSAGE REPLICATION"
+33 DO T^INHMG1
WRITE " file for Replicant Transaction Type, "_$PIECE($GET(^INRHT(+DA,0)),U)_"."
+34 DO T^INHMG1
WRITE !
End DoDot:1
QUIT 0
+35 ;
+36 ; get current status of base TT
SET INCUSTAT=$PIECE(^INRHT(INBASEDA,0),U,5)
+37 ;
+38 ; Perform activation process
+39 IF INST=1
IF 'INCUSTAT
Begin DoDot:1
+40 ; Base is NOT active - check for active replicants
+41 SET RHRTT=""
FOR
SET RHRTT=$ORDER(^INRHR("AC",INBASEDA,RHRTT))
IF 'RHRTT
QUIT
SET REPTT=+$PIECE(^INRHR(RHRTT,0),U)
Begin DoDot:2
+42 ; no warning if REPTT is calling replicant or is inactive
+43 IF (REPTT=DA)!('$PIECE($GET(^INRHT(REPTT,0)),U,5))
QUIT
+44 DO T^INHMG1
WRITE "WARNING: Transaction type ",$PIECE(^INRHT(REPTT,0),U)," was active. "
+45 DO T^INHMG1
WRITE " Messages will now be generated for this transaction type."
End DoDot:2
End DoDot:1
+46 ;
+47 ; Perform deactivation process
+48 ; exit if NOT OK to deactivate base & parent
IF 'INST
SET OK=1
IF INCUSTAT
Begin DoDot:1
+49 ; Base is active - check for active replicants
+50 ; no deactivation if REPTT is NOT the calling replicant & is active
+51 SET RHRTT=""
FOR
SET RHRTT=$ORDER(^INRHR("AC",INBASEDA,RHRTT))
IF 'RHRTT
QUIT
SET REPTT=+$PIECE(^INRHR(RHRTT,0),U)
IF REPTT'=DA
IF $PIECE($GET(^INRHT(REPTT,0)),U,5)
SET OK=0
QUIT
End DoDot:1
IF 'OK
QUIT 1
+52 ;
+53 ; De/Activate Base TT
+54 IF '$$TTEDT^INHPSA(INBASEDA,INST,.INHIER,"BASE")
QUIT 0
+55 ;
+56 ; De/Activate associated Parent TT
+57 IF '$$TTPAR^INHPSA(INBASEDA,INST,.INHIER)
QUIT 0
+58 ;
+59 QUIT 1
+60 ;-----------------
WRITE(INHIER,INST) ; write the transaction type, parent, base and child
+1 ;Input:
+2 ; INST = 0 - deactivate
+3 ; 1 - activate
+4 ; 2 - show
+5 ;
+6 ; INHIER - array where
+7 ; INHIER("PARENT") = INTERFACE TRANSACTION TYPE IEN for parent
+8 ; INHIER("BASE") = INTERFACE TRANSACTION TYPE IEN for base
+9 ; INHIER("CHILD") = INTERFACE TRANSACTION TYPE IEN for child
+10 ;
+11 NEW P,B,C,INMRG
+12 SET P=$GET(INHIER("PARENT"))
+13 SET B=$GET(INHIER("BASE"))
+14 SET C=$GET(INHIER("CHILD"))
+15 IF $PIECE($GET(^INRHT(+C,0)),U,8)'="I"
Begin DoDot:1
+16 SET INMRG=0
+17 IF P
DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE "Parent: ",$PIECE($GET(^INRHT(+P,0)),U),?68,$$GACT(+P,INST)
SET INMRG=INMRG+3
+18 IF B
DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE ?INMRG,"Base: ",$PIECE($GET(^INRHT(+B,0)),U),?68,$$GACT(+B,INST)
SET INMRG=INMRG+3
+19 DO T^INHMG1
IF $GET(DUOUT)
QUIT
+20 IF P&B
WRITE ?INMRG,"Rep - TT: "
+21 IF '$TEST
WRITE ?INMRG,$SELECT(P:"Child: ",1:"Trans: ")
+22 WRITE $PIECE($GET(^INRHT(+C,0)),U),?68,$$GACT(+C,INST)
+23 DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE ?22,"Destination: ",$PIECE($GET(^INRHD(+$PIECE($GET(^INRHT(+C,0)),U,2),0)),U)
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 DO T^INHMG1
IF $GET(DUOUT)
QUIT
+26 WRITE "IN - TT: ",$SELECT('C:"NONE",1:$PIECE($GET(^INRHT(+C,0)),U)),?68,$$GACT(+C,INST)
End DoDot:1
+27 DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE !
+28 QUIT
+29 ;
GACT(DA,INST) ; returns the verbos status of the transaction
+1 ;Input:
+2 ; DA = INTERFACE TRANSACTION TYPE IEN
+3 ; INST = 0 - deactivate
+4 ; 1 - activate
+5 ; 2 - show
+6 ;Output:
+7 ; returns the verbos status of the transaction
+8 ;
+9 NEW ISACT,INSTMSG
+10 IF 'DA
QUIT ""
+11 SET ISACT=$PIECE($GET(^INRHT(DA,0)),U,5)
+12 IF INST>1
SET INSTMSG=$SELECT('ISACT:"INACTIVE",1:"ACTIVE")
+13 IF '$TEST
SET INSTMSG=$SELECT('ISACT:"DEACTIVATED",1:"ACTIVATED")
+14 QUIT INSTMSG
+15 ;
DISCREP(ININT,INDAT) ;report this disrepancies
+1 ; Input:
+2 ; ININT - interface application to activate
+3 ; INDAT = data array of control file records fo application
+4 ;
+5 ; Note: For a future enhancement, you may want to add more than
+6 ; one destination ( entries in file# 4005) to the INHPSA1,
+7 ; INHPSA3 and INHPSA5 tables, Then make the INNAME,
+8 ; INDES arrays, with subscripts containing these destinations.
+9 ; Doing this prevent the program from generating bugus,
+10 ; report for interfaces like CRSPL or CRPSR that has
+11 ; more than one destination.
+12 NEW INNAME
+13 NEW INREC,TTNMA,INARR,FOUND,X
+14 SET INNAME=$GET(INDAT(ININT,4005,1))
+15 DO T^INHMG1
IF $GET(DUOUT)
QUIT
+16 SET X="Discrepancies Report for "_INNAME
+17 WRITE ?(IOM-$LENGTH(X))\2,X
+18 SET Y=""
SET $PIECE(Y,"*",$LENGTH(X)+1)=""
+19 DO T^INHMG1
IF $GET(DUOUT)
QUIT
+20 WRITE ?(IOM-$LENGTH(X))\2,Y
+21 IF INNAME=""
DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE "ERROR: No destination found in "_ININT
QUIT
+22 SET INDES=+$ORDER(^INRHD("B",$$UPCASE^%ZTF(INNAME),0))
+23 IF 'INDES
DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE "ERROR: "_INNAME_" not found in interface destination file"
QUIT
+24 SET INREC=0
+25 FOR
SET INREC=$ORDER(INDAT(ININT,4000,INREC))
IF 'INREC!$GET(DUOUT)
QUIT
Begin DoDot:1
+26 SET TTNAM=$PIECE(INDAT(ININT,4000,INREC),U)
+27 IF TTNAM=""
QUIT
+28 SET INTTIEN=$ORDER(^INRHT("B",TTNAM,0))
+29 IF 'INTTIEN
DO T^INHMG1
WRITE "ERROR: "_TTNAM_" not found in Interface Transaction file"
QUIT
+30 IF $PIECE($GET(^INRHT(INTTIEN,0)),U,8)="I"
QUIT
+31 IF $PIECE($GET(^INRHT(INTTIEN,0)),U,2)'=INDES
Begin DoDot:2
+32 DO T^INHMG1
WRITE "WARNING: "_TTNAM_" has destination "
+33 DO T^INHMG1
WRITE " "_$PIECE($GET(^INRHD(+$PIECE($GET(^INRHT(INTTIEN,0)),U,2),0)),U)
+34 ;--D T^INHMG1 W " Interface Destination file is not "_INNAME
End DoDot:2
QUIT
+35 SET INARR(TTNAM,"PRG")=INTTIEN
End DoDot:1
+36 IF $GET(DUOUT)
QUIT
+37 ;
+38 SET INTTIEN=0
+39 FOR
SET INTTIEN=$ORDER(^INRHT(INTTIEN))
IF 'INTTIEN
QUIT
Begin DoDot:1
+40 IF $PIECE($GET(^INRHT(INTTIEN,0)),U,8)="I"
QUIT
+41 IF $PIECE($GET(^INRHT(INTTIEN,0)),U,2)'=INDES
QUIT
+42 SET TTNAM=$PIECE($GET(^INRHT(INTTIEN,0)),U)
+43 SET INARR(TTNAM,"FM")=INTTIEN
End DoDot:1
+44 ;W !
+45 ;ZW INARR
+46 ;W !
+47 DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE !
+48 SET FOUND=0
+49 DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE !
+50 DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE "List of transactions that point to destination: "_INNAME_"."
+51 DO T^INHMG1
IF $GET(DUOUT)
QUIT
WRITE "But, are not activated/deactivated in EN^INHPSAM"
+52 SET FOUND=0
+53 SET TTNAM=""
+54 FOR
SET TTNAM=$ORDER(INARR(TTNAM))
IF $GET(TTNAM)=""!$GET(DUOUT)
QUIT
Begin DoDot:1
+55 IF $DATA(INARR(TTNAM,"FM"))
IF '$DATA(INARR(TTNAM,"PRG"))
Begin DoDot:2
+56 DO T^INHMG1
WRITE ?4,TTNAM
SET FOUND=1
End DoDot:2
End DoDot:1
+57 IF 'FOUND
DO T^INHMG1
WRITE " **** No transaction found *****"
+58 QUIT
