PRCHITM6 ;OI&T/LKG - LOAD MANUFACTURER ENTRIES FROM HOST FILE ;12/20/21 22:15
;;5.1;IFCAP;**198,226**;OCT 20, 2000;Build 2
;Per VA Directive 6402, this routine should not be modified.
;Integration agreements
; ICR #2320: CLOSE^%ZISH(),$$LIST^%ZISH(),OPEN^%ZISH(),$$STATUS^%ZISH()
; ICR #2171: $$STA^XUAF4()
; ICR #2541: $$KSP^XUPARAM()
; ICR #4440: $$PROD^XUPROD()
; ICR #10026: ^DIR
; ICR #10070: ^XMD
; ICR #10142: EN^DDIOL()
ST ;Entry point
N DIR,DTOUT,DUOUT,DIROUT,DIRUT,POP,X,Y,PRCI,PRCLFARR,PRCLFDIR,PRCLFF,PRCLFFIL,PRCLFIN,PRCFATAL S PRCFATAL=0
N ZTSK,ZTSAVE,ZTDTM,ZTRTN,ZTDESC,ZTIO,PRCX
GETDIR S DIR(0)="FA^1:75",DIR("A")="Enter the file's directory: ",DIR("B")="/srv/vista/patches/.NIF/"
S DIR("?",1)="Enter name of the directory containing the file.",DIR("?")=" Directory value is up to 75 characters in the format for the operating system."
D ^DIR I $D(DIRUT) S PRCFATAL=1 G END
S PRCLFDIR=Y
K DIR S DIR(0)="FA^1:50^K:X'?1.46ANP1"".""3A X",DIR("A")="Enter file name: ",DIR("?",1)="Enter the name of file with extension that you wish to process."
S DIR("?")="File name up to 50 characters, without directory.",DIR("B")="NIFMFGFILE.TXT"
D ^DIR I $D(DIRUT) S PRCFATAL=1 G END
S PRCLFFIL=Y K DIR
S PRCLFF(PRCLFFIL)="",PRCX=$$LIST^%ZISH(PRCLFDIR,"PRCLFF","PRCLFARR")
K PRCLFF,PRCLFARR
I 'PRCX W !,"File not found!" G GETDIR
D OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",)
I POP W !,"Unable to open file "_PRCLFDIR_PRCLFFIL_"." S PRCFATAL=1 G END
U IO
F PRCI=1:1 R PRCX:DTIME Q:$P(PRCX,"^",1,2)="HDR^MANUFACTURER LIST" Q:$$STATUS^%ZISH
I $P(PRCX,"^",1,2)'="HDR^MANUFACTURER LIST" U IO(0) D EN^DDIOL("*** Wrong file: Not for Manufacturer Load.","","!!?10") S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") G END
U IO(0) W !
K DIR S DIR(0)="YA",DIR("A")="Do you want to queue the manufacturer load? ",DIR("B")="YES"
S DIR("?")="Enter 'YES' to run in background or 'NO' to run in foreground."
D ^DIR I $D(DIRUT) S PRCFATAL=1 D CLOSE^%ZISH("PRCLFIN") G END
I Y D G END
. D CLOSE^%ZISH("PRCLFIN")
. S ZTRTN="RUN^PRCHITM6",ZTDESC="Manufacturer File (#440.4) Load",ZTIO=""
. S ZTSAVE("PRCLFDIR")="",ZTSAVE("PRCLFFIL")="",ZTSAVE("DUZ")="",ZTSAVE("DTIME")=""
. D ^%ZTLOAD W !,"Task #=",$G(ZTSK)
U IO
;
RUN ;
N POP,X,Y,PRCI,PRCJ,PRCK,PRCLFIN,PRCLFARR I $D(ZTQUEUED) N PRCX
N PRCTXN,PRCHNODE,PRCERRC,PRCLCTR,PRCIUPD,PRCITC,PRCFATAL S PRCLCTR=0,PRCIUPD=0,PRCFATAL=0
N PRCLINES,PRCSTN S PRCSTN=$$STA^XUAF4($$KSP^XUPARAM("INST")),PRCLINES=0
I $D(ZTQUEUED) D G:POP END
. D OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",,"P-OTHER")
. I POP D Q
. . N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
. . S XMSUB="IFCAP Manufacturer File Load Failure",XMDUZ=.5,XMY("G.ISM")="",XMY(DUZ)=""
. . S PRCARR(1)="Unable to open host file "_PRCLFDIR_PRCLFFIL,XMTEXT="PRCARR("
. . D ^XMD
. U IO
. F PRCI=1:1 R PRCX:DTIME Q:$P(PRCX,"^",1,2)="HDR^MANUFACTURER LIST" Q:$$STATUS^%ZISH
I '$$STATUS^%ZISH D
. S PRCTXN=$P(PRCX,"^",5) D INITLOG(PRCTXN)
. F PRCI=1:1 R PRCX:DTIME Q:$$STATUS^%ZISH!($P(PRCX,"^")="***END OF FILE***") D
. . I $P(PRCX,"^")="REC" D
. . . N PRCARR,PRCDUNS,PRCERR,PRCIEN,PRCNAME,PRCSTATUS S PRCIEN(1)=$P(PRCX,"^",2),PRCNAME=$P(PRCX,"^",3),PRCDUNS=$P(PRCX,"^",4),PRCSTATUS=$P(PRCX,"^",5)
. . . S PRCLINES=PRCLINES+1
. . . I +PRCIEN(1)'=PRCIEN(1)!(PRCIEN(1)'>0) S PRCERR("DIERR")=1,PRCERR("DIERR",1,"TEXT",1)="The value '"_PRCIEN(1)_"' for field ID NUMBER in file MANUFACTURER is not valid." D LOGERR(.PRCERR,PRCIEN(1)) Q
. . . I '$D(^PRC(440.4,PRCIEN(1))) D Q
. . . . S PRCARR(440.4,"+1,",.001)=PRCIEN(1),PRCARR(440.4,"+1,",.01)=PRCNAME
. . . . S:PRCDUNS'="" PRCARR(440.4,"+1,",.5)=PRCDUNS
. . . . S:PRCSTATUS="I" PRCARR(440.4,"+1,",1)="INACTIVE"
. . . . I ";A;I;"'[(";"_PRCSTATUS_";") S PRCARR(440.4,"+1,",1)=PRCSTATUS
. . . . D UPDATE^DIE("EK","PRCARR","PRCIEN","PRCERR")
. . . . D:$D(PRCERR) LOGERR(.PRCERR,PRCIEN(1))
. . . . S:'$D(PRCERR) PRCLCTR=PRCLCTR+1
. . . S PRCARR(440.4,PRCIEN(1)_",",.01)=PRCNAME
. . . S:PRCDUNS'="" PRCARR(440.4,PRCIEN(1)_",",.5)=PRCDUNS
. . . S:PRCSTATUS'="" PRCARR(440.4,PRCIEN(1)_",",1)=$S(PRCSTATUS="I":"INACTIVE",PRCSTATUS="A":"@",1:PRCSTATUS)
. . . D FILE^DIE("EK","PRCARR","PRCERR")
. . . D:$D(PRCERR) LOGERR(.PRCERR,PRCIEN(1))
. . . S:'$D(PRCERR) PRCIUPD=PRCIUPD+1
D CLOSE^%ZISH("PRCLFIN")
;
I $D(PRCHNODE),$D(^XTMP(PRCHNODE,"ERR")) D
. N PRCARR,PRCC,PRCI,PRCJ,PRCK,PRCL S PRCC=0,PRCI=0,PRCJ=0,PRCK=0,PRCL=120
. F S PRCI=$O(^XTMP(PRCHNODE,"ERR",PRCI)) Q:PRCI="" S PRCC=PRCC+1
. S PRCC=PRCC\PRCL+$S(PRCC#PRCL>0:1,1:0),PRCI=0
. F S PRCI=$O(^XTMP(PRCHNODE,"ERR",PRCI)) Q:PRCI="" D
. . S PRCJ=PRCJ+1,PRCARR(PRCJ)=^XTMP(PRCHNODE,"ERR",PRCI)
. . I PRCJ=PRCL D
. . . S PRCK=PRCK+1 D SEND(.PRCARR,PRCTXN,PRCK,PRCC,PRCSTN)
. . . K PRCARR S PRCJ=0
. I $D(PRCARR) S PRCK=PRCK+1 D SEND(.PRCARR,PRCTXN,PRCK,PRCC,PRCSTN)
I $D(PRCHNODE) D
. N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCARR
. S XMSUB="Stn "_PRCSTN_" Statistics Manufacturer Load File "_PRCTXN
. S PRCARR(1)="Number of Manufacturer records: "_PRCLINES
. S PRCARR(2)="Number of file entries successfully created: "_PRCLCTR,PRCARR(3)="Number of file entries successfully updated: "_PRCIUPD
. S XMDUZ=.5,XMTEXT="PRCARR(",XMY("G.ISM")="",XMY(DUZ)=""
. S:$$PROD^XUPROD() XMY("VHANIFMO@domain.ext")=""
. D ^XMD
END ;
S:$D(ZTQUEUED) ZTREQ="@"
W:'$D(ZTQUEUED) !!,$S(PRCFATAL:"<LOAD ABORTED>",1:"<DONE>")
K PRCLFDIR,PRCLFFILE
Q
INITLOG(PRCTXNID) ; Initialize error log
N PRCDT,X1,X2,X,%H
S PRCERRC=0,PRCHNODE="PRCHITM6;"_PRCTXNID K ^XTMP(PRCHNODE)
; Setting up ^XTMP header node including automatic purge date
S PRCDT=$$DT^XLFDT,X1=PRCDT,X2=30 D C^%DTC S ^XTMP(PRCHNODE,0)=X_"^"_PRCDT_"^"_"IFCAP MANUFACTURER LOAD"
Q
LOGERR(PRCE,PRCID) ; Record errors
N PRCI,PRCK,PRCM S PRCK=$P($G(PRCERR("DIERR")),"^") Q:+PRCK'>0
F PRCI=1:1:PRCK D
. S PRCM=$G(PRCE("DIERR",PRCI,"TEXT",1)) I PRCM'="" S PRCM="ID Number:"_PRCID_": "_PRCM
. S PRCERRC=PRCERRC+1 S ^XTMP(PRCHNODE,"ERR",PRCERRC)=PRCM
Q
;
;
; Send e-mails with error messages
SEND(PRCA,PRCB,PRCC,PRCD,PRCE) ;
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S XMSUB="Stn "_PRCE_" Errors Manufacturer Load File "_PRCB_" Msg #"_PRCC_" of "_PRCD
S XMDUZ=.5,XMTEXT="PRCA(",XMY("G.ISM")="",XMY(DUZ)=""
S:$$PROD^XUPROD() XMY("VHANIFMO@domain.ext")=""
D ^XMD
Q
;
;PRCHITM6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHITM6 6388 printed Nov 22, 2024@17:18:11 Page 2
PRCHITM6 ;OI&T/LKG - LOAD MANUFACTURER ENTRIES FROM HOST FILE ;12/20/21 22:15
+1 ;;5.1;IFCAP;**198,226**;OCT 20, 2000;Build 2
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Integration agreements
+4 ; ICR #2320: CLOSE^%ZISH(),$$LIST^%ZISH(),OPEN^%ZISH(),$$STATUS^%ZISH()
+5 ; ICR #2171: $$STA^XUAF4()
+6 ; ICR #2541: $$KSP^XUPARAM()
+7 ; ICR #4440: $$PROD^XUPROD()
+8 ; ICR #10026: ^DIR
+9 ; ICR #10070: ^XMD
+10 ; ICR #10142: EN^DDIOL()
ST ;Entry point
+1 NEW DIR,DTOUT,DUOUT,DIROUT,DIRUT,POP,X,Y,PRCI,PRCLFARR,PRCLFDIR,PRCLFF,PRCLFFIL,PRCLFIN,PRCFATAL
SET PRCFATAL=0
+2 NEW ZTSK,ZTSAVE,ZTDTM,ZTRTN,ZTDESC,ZTIO,PRCX
GETDIR SET DIR(0)="FA^1:75"
SET DIR("A")="Enter the file's directory: "
SET DIR("B")="/srv/vista/patches/.NIF/"
+1 SET DIR("?",1)="Enter name of the directory containing the file."
SET DIR("?")=" Directory value is up to 75 characters in the format for the operating system."
+2 DO ^DIR
IF $DATA(DIRUT)
SET PRCFATAL=1
GOTO END
+3 SET PRCLFDIR=Y
+4 KILL DIR
SET DIR(0)="FA^1:50^K:X'?1.46ANP1"".""3A X"
SET DIR("A")="Enter file name: "
SET DIR("?",1)="Enter the name of file with extension that you wish to process."
+5 SET DIR("?")="File name up to 50 characters, without directory."
SET DIR("B")="NIFMFGFILE.TXT"
+6 DO ^DIR
IF $DATA(DIRUT)
SET PRCFATAL=1
GOTO END
+7 SET PRCLFFIL=Y
KILL DIR
+8 SET PRCLFF(PRCLFFIL)=""
SET PRCX=$$LIST^%ZISH(PRCLFDIR,"PRCLFF","PRCLFARR")
+9 KILL PRCLFF,PRCLFARR
+10 IF 'PRCX
WRITE !,"File not found!"
GOTO GETDIR
+11 DO OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",)
+12 IF POP
WRITE !,"Unable to open file "_PRCLFDIR_PRCLFFIL_"."
SET PRCFATAL=1
GOTO END
+13 USE IO
+14 FOR PRCI=1:1
READ PRCX:DTIME
if $PIECE(PRCX,"^",1,2)="HDR^MANUFACTURER LIST"
QUIT
if $$STATUS^%ZISH
QUIT
+15 IF $PIECE(PRCX,"^",1,2)'="HDR^MANUFACTURER LIST"
USE IO(0)
DO EN^DDIOL("*** Wrong file: Not for Manufacturer Load.","","!!?10")
SET PRCFATAL=1
DO CLOSE^%ZISH("PRCLFIN")
GOTO END
+16 USE IO(0)
WRITE !
+17 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you want to queue the manufacturer load? "
SET DIR("B")="YES"
+18 SET DIR("?")="Enter 'YES' to run in background or 'NO' to run in foreground."
+19 DO ^DIR
IF $DATA(DIRUT)
SET PRCFATAL=1
DO CLOSE^%ZISH("PRCLFIN")
GOTO END
+20 IF Y
Begin DoDot:1
+21 DO CLOSE^%ZISH("PRCLFIN")
+22 SET ZTRTN="RUN^PRCHITM6"
SET ZTDESC="Manufacturer File (#440.4) Load"
SET ZTIO=""
+23 SET ZTSAVE("PRCLFDIR")=""
SET ZTSAVE("PRCLFFIL")=""
SET ZTSAVE("DUZ")=""
SET ZTSAVE("DTIME")=""
+24 DO ^%ZTLOAD
WRITE !,"Task #=",$GET(ZTSK)
End DoDot:1
GOTO END
+25 USE IO
+26 ;
RUN ;
+1 NEW POP,X,Y,PRCI,PRCJ,PRCK,PRCLFIN,PRCLFARR
IF $DATA(ZTQUEUED)
NEW PRCX
+2 NEW PRCTXN,PRCHNODE,PRCERRC,PRCLCTR,PRCIUPD,PRCITC,PRCFATAL
SET PRCLCTR=0
SET PRCIUPD=0
SET PRCFATAL=0
+3 NEW PRCLINES,PRCSTN
SET PRCSTN=$$STA^XUAF4($$KSP^XUPARAM("INST"))
SET PRCLINES=0
+4 IF $DATA(ZTQUEUED)
Begin DoDot:1
+5 DO OPEN^%ZISH("PRCLFIN",PRCLFDIR,PRCLFFIL,"R",,"P-OTHER")
+6 IF POP
Begin DoDot:2
+7 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+8 SET XMSUB="IFCAP Manufacturer File Load Failure"
SET XMDUZ=.5
SET XMY("G.ISM")=""
SET XMY(DUZ)=""
+9 SET PRCARR(1)="Unable to open host file "_PRCLFDIR_PRCLFFIL
SET XMTEXT="PRCARR("
+10 DO ^XMD
End DoDot:2
QUIT
+11 USE IO
+12 FOR PRCI=1:1
READ PRCX:DTIME
if $PIECE(PRCX,"^",1,2)="HDR^MANUFACTURER LIST"
QUIT
if $$STATUS^%ZISH
QUIT
End DoDot:1
if POP
GOTO END
+13 IF '$$STATUS^%ZISH
Begin DoDot:1
+14 SET PRCTXN=$PIECE(PRCX,"^",5)
DO INITLOG(PRCTXN)
+15 FOR PRCI=1:1
READ PRCX:DTIME
if $$STATUS^%ZISH!($PIECE(PRCX,"^")="***END OF FILE***")
QUIT
Begin DoDot:2
+16 IF $PIECE(PRCX,"^")="REC"
Begin DoDot:3
+17 NEW PRCARR,PRCDUNS,PRCERR,PRCIEN,PRCNAME,PRCSTATUS
SET PRCIEN(1)=$PIECE(PRCX,"^",2)
SET PRCNAME=$PIECE(PRCX,"^",3)
SET PRCDUNS=$PIECE(PRCX,"^",4)
SET PRCSTATUS=$PIECE(PRCX,"^",5)
+18 SET PRCLINES=PRCLINES+1
+19 IF +PRCIEN(1)'=PRCIEN(1)!(PRCIEN(1)'>0)
SET PRCERR("DIERR")=1
SET PRCERR("DIERR",1,"TEXT",1)="The value '"_PRCIEN(1)_"' for field ID NUMBER in file MANUFACTURER is not valid."
DO LOGERR(.PRCERR,PRCIEN(1))
QUIT
+20 IF '$DATA(^PRC(440.4,PRCIEN(1)))
Begin DoDot:4
+21 SET PRCARR(440.4,"+1,",.001)=PRCIEN(1)
SET PRCARR(440.4,"+1,",.01)=PRCNAME
+22 if PRCDUNS'=""
SET PRCARR(440.4,"+1,",.5)=PRCDUNS
+23 if PRCSTATUS="I"
SET PRCARR(440.4,"+1,",1)="INACTIVE"
+24 IF ";A;I;"'[(";"_PRCSTATUS_";")
SET PRCARR(440.4,"+1,",1)=PRCSTATUS
+25 DO UPDATE^DIE("EK","PRCARR","PRCIEN","PRCERR")
+26 if $DATA(PRCERR)
DO LOGERR(.PRCERR,PRCIEN(1))
+27 if '$DATA(PRCERR)
SET PRCLCTR=PRCLCTR+1
End DoDot:4
QUIT
+28 SET PRCARR(440.4,PRCIEN(1)_",",.01)=PRCNAME
+29 if PRCDUNS'=""
SET PRCARR(440.4,PRCIEN(1)_",",.5)=PRCDUNS
+30 if PRCSTATUS'=""
SET PRCARR(440.4,PRCIEN(1)_",",1)=$SELECT(PRCSTATUS="I":"INACTIVE",PRCSTATUS="A":"@",1:PRCSTATUS)
+31 DO FILE^DIE("EK","PRCARR","PRCERR")
+32 if $DATA(PRCERR)
DO LOGERR(.PRCERR,PRCIEN(1))
+33 if '$DATA(PRCERR)
SET PRCIUPD=PRCIUPD+1
End DoDot:3
End DoDot:2
End DoDot:1
+34 DO CLOSE^%ZISH("PRCLFIN")
+35 ;
+36 IF $DATA(PRCHNODE)
IF $DATA(^XTMP(PRCHNODE,"ERR"))
Begin DoDot:1
+37 NEW PRCARR,PRCC,PRCI,PRCJ,PRCK,PRCL
SET PRCC=0
SET PRCI=0
SET PRCJ=0
SET PRCK=0
SET PRCL=120
+38 FOR
SET PRCI=$ORDER(^XTMP(PRCHNODE,"ERR",PRCI))
if PRCI=""
QUIT
SET PRCC=PRCC+1
+39 SET PRCC=PRCC\PRCL+$SELECT(PRCC#PRCL>0:1,1:0)
SET PRCI=0
+40 FOR
SET PRCI=$ORDER(^XTMP(PRCHNODE,"ERR",PRCI))
if PRCI=""
QUIT
Begin DoDot:2
+41 SET PRCJ=PRCJ+1
SET PRCARR(PRCJ)=^XTMP(PRCHNODE,"ERR",PRCI)
+42 IF PRCJ=PRCL
Begin DoDot:3
+43 SET PRCK=PRCK+1
DO SEND(.PRCARR,PRCTXN,PRCK,PRCC,PRCSTN)
+44 KILL PRCARR
SET PRCJ=0
End DoDot:3
End DoDot:2
+45 IF $DATA(PRCARR)
SET PRCK=PRCK+1
DO SEND(.PRCARR,PRCTXN,PRCK,PRCC,PRCSTN)
End DoDot:1
+46 IF $DATA(PRCHNODE)
Begin DoDot:1
+47 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,PRCARR
+48 SET XMSUB="Stn "_PRCSTN_" Statistics Manufacturer Load File "_PRCTXN
+49 SET PRCARR(1)="Number of Manufacturer records: "_PRCLINES
+50 SET PRCARR(2)="Number of file entries successfully created: "_PRCLCTR
SET PRCARR(3)="Number of file entries successfully updated: "_PRCIUPD
+51 SET XMDUZ=.5
SET XMTEXT="PRCARR("
SET XMY("G.ISM")=""
SET XMY(DUZ)=""
+52 if $$PROD^XUPROD()
SET XMY("VHANIFMO@domain.ext")=""
+53 DO ^XMD
End DoDot:1
END ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 if '$DATA(ZTQUEUED)
WRITE !!,$SELECT(PRCFATAL:"<LOAD ABORTED>",1:"<DONE>")
+3 KILL PRCLFDIR,PRCLFFILE
+4 QUIT
INITLOG(PRCTXNID) ; Initialize error log
+1 NEW PRCDT,X1,X2,X,%H
+2 SET PRCERRC=0
SET PRCHNODE="PRCHITM6;"_PRCTXNID
KILL ^XTMP(PRCHNODE)
+3 ; Setting up ^XTMP header node including automatic purge date
+4 SET PRCDT=$$DT^XLFDT
SET X1=PRCDT
SET X2=30
DO C^%DTC
SET ^XTMP(PRCHNODE,0)=X_"^"_PRCDT_"^"_"IFCAP MANUFACTURER LOAD"
+5 QUIT
LOGERR(PRCE,PRCID) ; Record errors
+1 NEW PRCI,PRCK,PRCM
SET PRCK=$PIECE($GET(PRCERR("DIERR")),"^")
if +PRCK'>0
QUIT
+2 FOR PRCI=1:1:PRCK
Begin DoDot:1
+3 SET PRCM=$GET(PRCE("DIERR",PRCI,"TEXT",1))
IF PRCM'=""
SET PRCM="ID Number:"_PRCID_": "_PRCM
+4 SET PRCERRC=PRCERRC+1
SET ^XTMP(PRCHNODE,"ERR",PRCERRC)=PRCM
End DoDot:1
+5 QUIT
+6 ;
+7 ;
+8 ; Send e-mails with error messages
SEND(PRCA,PRCB,PRCC,PRCD,PRCE) ;
+1 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET XMSUB="Stn "_PRCE_" Errors Manufacturer Load File "_PRCB_" Msg #"_PRCC_" of "_PRCD
+3 SET XMDUZ=.5
SET XMTEXT="PRCA("
SET XMY("G.ISM")=""
SET XMY(DUZ)=""
+4 if $$PROD^XUPROD()
SET XMY("VHANIFMO@domain.ext")=""
+5 DO ^XMD
+6 QUIT
+7 ;
+8 ;PRCHITM6