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

INHVMTR.m

Go to the documentation of this file. 
  1. INHVMTR ; DGH,FRW ; 06 Aug 1999 14:44:52; MHCMIS background processor
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;Modified 5/13/98 to suport multiple MHCMIS/CEIS systems.
  1.  ;This is a background process to write interface messages to
  1.  ;VMS files. It combines elements of the generic background
  1.  ;processor ^INHVTAPT with the Ver 3.0 MHCMIS transmitter, ^INHVMTR
  1.  ;INPUT:
  1.  ; INBPN = Background processor
  1.  ;KEY VARIABLES:
  1.  ; INENDTM = $H time a VMS file should close, or 0 if no file is open
  1.  ;
  1. EN ;Main starting point
  1.  N DT,INENDTM,ER,I,INDSTR,INIP,INQP,INQT,INUIF,LCT,LINE,INOK,SYSTEM,X,XXDFN,XXDTRDA,INFILOPN,INRUN,WAIT,INPNAME,INCEIS,XXNO
  1.  ;Start GIS Background process audit if flag is set in Site Parms File
  1.  S INPNAME=$P(^INTHPC(INBPN,0),U) D AUDCHK^XUSAUD D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME)
  1.  S X="ERR^INHVMTR",@^%ZOSF("TRAP")
  1.  S SYSTEM="SC",INDSTR=+$P(^INTHPC(INBPN,0),U,7) I 'INDSTR D ENR^INHE("MHCMIS - No destination designated for background process "_INBPN) G EXIT
  1.  G:'$D(^INRHB("RUN",INBPN)) EXIT S ^INRHB("RUN",INBPN)=$H_U_"Starting"
  1.  ; intialize variables from background process file
  1.  D INIT^INHUVUT(INBPN,.INIP)
  1.  ;Get variables from MHCMIS SITE PARAMETER FILE based on match between
  1.  ;the numbers embedded in the .01 fields of ^INRHD and ^XXDBE
  1.  S XXNO=$$MHC^INHUT2($P(^INRHD(INDSTR,0),U)) D
  1.  .;Default to ien=1
  1.  .I +XXNO<2 S INCEIS=1 Q
  1.  .;Otherwise find the entry that contains the same numeric value
  1.  .N OUT,IEN,X S OUT=0,IEN=1 F  S IEN=$O(^XXDBE(30203,IEN)) Q:'IEN!OUT  D
  1.  ..S X=$$MHC^INHUT2($P(^XXDBE(30203,IEN,0),U))
  1.  ..I X=XXNO S (OUT,INCEIS)=IEN
  1.  S:'$G(INCEIS) INCEIS=1
  1.  ;Get length of time to keep VMS file open. Minimum of 20
  1.  S INFILOPN=+$G(^XXDBE(30203,INCEIS,3)) S:INFILOPN<20 INFILOPN=20
  1.  S INENDTM=0
  1.  ;
  1. RUN ;This is main loop of routine.
  1.  S INRUN=$$INRHB^INHUVUT1(INBPN,"Idle") G:'INRUN EXIT
  1.  ;Update background process audit
  1.  D:$D(XUAUDIT) ITIME^XUSAUD(INPNAME)
  1.  ;If a VMS file has been open the allocated time, close it
  1.  I INENDTM D
  1.  .S INOK=$$CHKTM(INENDTM)
  1.  .Q:INOK
  1.  .D:$D(XXDFN) CLOSE(XXDFN) S INENDTM=0
  1.  ;Loop until a transaction exists on the destination queue
  1.  ;If re-trying a message, it will still be at top of queue
  1.  S INUIF=$$NEXT^INHUVUT3(INDSTR,.INQP,.INQT)
  1.  I 'INUIF D WAIT^INHUVUT(INBPN,INIP("THNG")) G RUN
  1.  ;
  1.  ;If there is a message to write, be sure a file is open
  1.  I 'INENDTM D
  1.  .S XXDTRDA=$$GETFIL(.XXDFN)
  1.  .I XXDTRDA S INENDTM=$$SETTM(INFILOPN) Q
  1.  .;If file not opened, update run global
  1.  .I 'XXDTRDA S INRUN=$$INRHB^INHUVUT1(INBPN,"File error",2)
  1.  G:'INRUN EXIT
  1.  ;
  1.  ;If file is not opened, hang 1200 sec and try again,
  1.  ;based on send hang parameter (which is in seconds)
  1.  I 'XXDTRDA D QULOCK S WAIT=$S(INIP("SHNG")>0:INIP("SHNG"),1:1200) D WAIT^INHUVUT(INBPN,WAIT) G RUN
  1.  ;
  1.  ;else file is open, proceed
  1.  S INRUN=$$INRHB^INHUVUT1(INBPN,"Transmitting")
  1.  G:'INRUN EXIT
  1.  ;GIS audit call
  1.  D:$D(XUAUDIT) TTSTRT^XUSAUD(INUIF,"",INPNAME,"","TRANSMIT")
  1.  ;;
  1.  ;Append message to file
  1.  S LCT=0 F  D GETLINE^INHOU(INUIF,.LCT,.LINE) Q:'$D(LINE)  D
  1.  .  ;copy main line
  1.  .  U XXDFN W LINE
  1.  .  ;copy any overflow nodes
  1.  .  F I=1:1 Q:'$D(LINE(I))  U XXDFN W LINE(I)
  1.  .  U XXDFN W !
  1.  ;
  1.  ;Write EOM character
  1.  U XXDFN W $C(28),!
  1.  ;Stop GIS Transaction Type audit
  1.  D:$D(XUAUDIT) TTSTP^XUSAUD(0)
  1.  ;
  1.  ;Kill from queue and loop
  1.  D QKILL,LOG
  1.  S INRUN=$$INRHB^INHUVUT1(INBPN,"Transmission complete",1)
  1.  G RUN
  1.  ;
  1. LOG ;Log status of original message
  1.  ;INHOS needs UIF and ER=0,1,or 2
  1.  N UIF S UIF=INUIF,ER=0
  1.  D DONE^INHOS
  1.  Q
  1.  ;
  1. QKILL K ^INLHDEST(INDSTR,INQP,INQT,INUIF)
  1.  D QULOCK
  1.  Q
  1.  ;
  1. GETFIL(XXDFN) ;Get VMS file name to open
  1.  ;XXDFN is file to open, pass by reference. To work with MSM on PC
  1.  ;this will be the value returned from OPENSEQ^%ZTFS1, which includes
  1.  ;the device number,full file and path.
  1.  N DA,EXT,FIL,XXDIR,X,DIC,Y,DLAYGO,DIK,DATE,FIL1,OK,FILNAM
  1.  K XXDFN
  1.  ;Directory to write files to
  1.  D SETDT^UTDT S XXDIR=$G(^XXDBE(30203,INCEIS,1))_"MH",DATE=$E(DT,2,7)
  1.  ;Last file name stored in ^XXDFIL("AC",INCEIS)
  1.  ;Until file is open or EXT=999
  1.  S XXDTRDA=0 F  D  Q:XXDTRDA!(EXT>999)
  1.  .;First get file and extension
  1.  .D  Q:EXT>999
  1.  ..S FIL=$G(^XXDFIL("AC",INCEIS))
  1.  ..I '$L(FIL)!($P(FIL,".")'=DATE) S EXT="001" Q
  1.  ..;else increment last extension
  1.  ..S EXT=$P(FIL,".",2)+1 Q:EXT>999
  1.  ..I $L(EXT)<3 F  S EXT="0"_EXT Q:$L(EXT)=3
  1.  .S FIL=DATE_"."_EXT,^XXDFIL("AC",INCEIS)=FIL,FILNAM=XXDIR_FIL
  1.  .;try to add entry to transaction file
  1.  .S XXDTRDA=$$TRANA(FILNAM) Q:'XXDTRDA
  1.  .;try to open file
  1.  .S XXDFN=$$OPEN(FILNAM)
  1.  .I '$L(XXDFN) D ENR^INHE(INBPN,"MHCMIS - Unable to open file "_$G(FILNAM)) D
  1.  ..;If file is new, but can't be opened, kill entry from tracking file
  1.  ..;Third piece of XXDTRDA corrosponds to $P(Y,U,3) in DIC call
  1.  ..Q:'$P(XXDTRDA,U,3)
  1.  ..S DIK="^XXDFIL(",DA=+XXDTRDA D ^DIK
  1.  .S:'$L(XXDFN) XXDTRDA=0
  1.  I 'XXDTRDA D ENR^INHE("MHCMIS - Failure to create file for period "_XXDIR_FIL) K XXDFN
  1.  Q +XXDTRDA
  1.  ;
  1. TRANA(X) ;Add/find entry in transmission tracking file (30205)
  1.  Q:'$L(X) 0
  1.  S DIC(0)="MNLZ",DIC="^XXDFIL(",DLAYGO=30205 D ^DIC S:Y<0 Y=0
  1.  I 'Y D ENR^INHE(INBPN,"Unable to open file "_X) Q 0
  1.  ;See if file has already been transmitted
  1.  I $P(^XXDFIL(+Y,0),U,2) D ENR^INHE(INBPN,"MHCHMIS - file "_X_" has already been transmitted") Q 0
  1.  Q Y
  1.  ;
  1. OPEN(FILNAM) ;Open VMS file XXDFN
  1.  N %
  1.  ;make sure file doesn't already exist and quit if it does
  1.  Q:$L($$OPENSEQ^%ZTFS1(FILNAM,"R")) 0
  1.  ;Then try to open new file
  1.  Q $$OPENSEQ^%ZTFS1(FILNAM,"WA")
  1.  ;
  1. SETTM(INFILOPN) ;Set closing time (no later than midnight of current day)
  1.  ;INPUT: INFILOPN=length of time to be open in minutes
  1.  N NOW,OPEN,CLOSE
  1.  ;Closing time is current time + INFILOPN
  1.  ;less 120 seconds to avoid possible conflict with FTP process
  1.  S NOW=$$NOW^UTDT,OPEN=INFILOPN-2
  1.  S CLOSE=$$ADDT^UTDT(NOW,0,0,OPEN)
  1.  I $P(CLOSE,".")'=$P(NOW,".") S CLOSE=$P(NOW,".")_".24"
  1.  ;Convert closing time to $H format
  1.  S X=$$CDATF2H^UTDT(CLOSE)
  1.  ;Update transmission tracking file with time to close (used for FTP)
  1.  D TRANU(XXDTRDA,CLOSE,INCEIS)
  1.  Q X
  1.  ;
  1. CHKTM(INENDTM) ;Compare current time with time to close VMS file
  1.  ;INENDTM = $H format of time to end.
  1.  ;Return 1 if okay to keep writing to this file, 0 if time to close
  1.  ;If file has been open past midnight, it's time to close
  1.  Q:+INENDTM'=+$H 0
  1.  ;If current time is later than time to close
  1.  Q:$P(INENDTM,",",2)<$P($H,",",2) 0
  1.  Q 1
  1.  ;
  1. ERR ;Error module
  1.  N INREERR S INREERR=$$GETERR^%ZTOS
  1.  ;If unanticipated error is encounterd close transmitter
  1.  I $D(XXDFN) D CLOSE(XXDFN)
  1.  D ENR^INHE(INBPN,"MHCMIS - Fatal error encountered by TRANSCEIVER  - "_INREERR_" in background process "_INBPN)
  1.  X $G(^INTHOS(1,3))
  1.  ;
  1. EXIT ;Main exit module
  1.  D QULOCK
  1.  D:$D(XXDFN) CLOSE(XXDFN)
  1.  K ^INRHB("RUN",INBPN)
  1.  ;Stop background process audit
  1.  D:$D(XUAUDIT) AUDSTP^XUSAUD
  1.  Q
  1.  ;
  1. QULOCK L:$G(INUIF) -^INLHDEST(INDSTR,INQP,INQT,INUIF)
  1.  Q
  1.  ;
  1. CLOSE(XXDFN) ;Close file
  1.  S OK=$$CLOSESEQ^%ZTFS1(XXDFN)
  1.  I 'OK D ENR^INHE(INBPN,"MHCMIS - Error in closing ASCII file "_XXDFN)
  1.  K XXDFN
  1.  Q
  1.  ;
  1. TRANU(DA,CLOSE,INCEIS) ;Update entry in MHCMIS Data Exchange file (#30205)
  1.  Q:'$G(DA)
  1.  ;S $P(^XXDFIL(DA,0),U,3,5)="^"_CLOSE_"^"
  1.  ;S $P(^XXDFIL(DA,0),U,3,5)="^"_$$NOW^%ZTFDT_"^"
  1.  S $P(^XXDFIL(DA,0),U,4)=CLOSE,$P(^(0),U,6)=INCEIS
  1.  Q
  1.  ;