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

INHD.m

Go to the documentation of this file. 
  1. INHD ; cmi/flag/maw - FRW,DGH,JSH 29 Aug 97 08:42 Interface Input Driver 07 Oct 91 6:44 AM ; [ 09/09/2004  1:23 PM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**1,12**;JUN 01, 2002
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;cmi/maw modified STORE sub to strip off |CR|
  1.  ;
  1. NEWO(DEST,G,ACK,TT,MID,%OUT,INORDUZ,INORDIV,INUIF6,INUIF7,INMIDGEN) ;Make a new outgoing entry
  1.  ;INPUT:
  1.  ;DEST   = Entry # of a destination (file #4005)
  1.  ;G      = Global reference of lines of data:   $G@(n) n=1,2,3,...
  1.  ;ACK    = Acknowledge required (0 = NO, 1 = YES)
  1.  ;TT     = Originating Transaction Type (file #4000)
  1.  ;MID    = Message ID
  1.  ;%OUT   = Allow output controller to process (0=yes 1=no)
  1.  ;INORDUZ = originating user, ien to USER file #3
  1.  ;INORDIV = originating division, 
  1.  ;          ien to MEDICAL CENTER DIVISION file 40.8
  1.  ;INUIF6 = (opt) See INDA.
  1.  ;INUIF7 = (opt) See INA.
  1.  ;INMIDGEN = message ID of originating message (from node 0 piece 5)
  1.  ; INA      - (opt) Selected subnodes of INA array are merged into
  1.  ;                  the outbound msg after outbound script execution.
  1.  ;                  Used by application teams' screening logic
  1.  ;                  (@INA@("node")).  Data may already reside in
  1.  ;                  INUIF7.
  1.  ; INDA     - (opt) INDA array is merged into the outbound msg as it
  1.  ;                  exists prior to outbound script execution.  Used
  1.  ;                  by appl. teams' screening logic (@INDA@("node")).
  1.  ;                  Data may already reside in INUIF6.
  1.  ;
  1.  ;OUTPUT:
  1.  ;Function value - entry # in UIF or -1 (if error)
  1.  ;
  1.  S X="ERROR^INHD",@^%ZOSF("TRAP")
  1.  I '$G(DEST)!($G(G)="")!($G(ACK)="")!'$G(TT) Q -1
  1.  Q:'$D(^INRHD(DEST)) -1
  1.  N H,C,I,X,DA,DIC,DR,TIME,SRC,DO,Y,DIC,DD,DIE,DLAYGO,INHNOW
  1.  ;cmi/anch/maw 9/8/2004 made a change to call FILE^DICN
  1.  ;S X="NOW",DLAYGO=4001,DIC="^INTHU(",DIC(0)="FL" D ^DICN  ;cmi/maw orig
  1.  D NOW^%DTC S INHNOW=$G(%)
  1.  K DD,DO S X=INHNOW,DLAYGO=4001,DIC="^INTHU(",DIC(0)="L" D FILE^DICN  ;cmi/anch/maw new
  1.  I Y<0 D FAILO Q -1
  1.  S DA=+Y L +^INTHU(DA)
  1.  N INMID,INDEST,INSRC,ING,INNEACK,INDIR,INNEOUT,INTT,INORGIEN
  1.  S INMIDGEN=$G(INMIDGEN)
  1.  S INMID=MID,INDEST=DEST,ING=G,INNEACK=ACK,INDIR="OUT",INNEOUT=$G(%OUT),INSRC="",INTT=TT S INORGIEN=$S('$L(INMIDGEN):"",1:$O(^INTHU("C",INMIDGEN,0)))
  1.  S DIE="^INTHU(",DR="[INH MESSAGE NEW]" D ^DIE
  1.  I $D(INUIF6) M ^INTHU(DA,6)=INUIF6
  1.  I '$D(INUIF6),$D(INDA) M ^INTHU(DA,6)=INDA
  1.  I $D(INUIF7) M ^INTHU(DA,7)=INUIF7
  1.  I '$D(INUIF7) D
  1.  . I $D(INA("DMISID")) M ^INTHU(DA,7,"DMISID")=INA("DMISID")
  1.  . I $D(INA("MSGTYPE")) M ^INTHU(DA,7,"MSGTYPE")=INA("MSGTYPE")
  1.  D STORE
  1.  L -^INTHU(DA)
  1.  Q DA
  1.  ;
  1. STORE ;Store text in message file (INTHU)
  1.  ;INPUT:
  1.  ;  DA - ien in INTHU
  1.  ;  G - location (array) of message
  1.  ;  DEST, %OUT, TT (opt)
  1.  ;OUTPUT:
  1.  ;  TT - ien of Transaction Type
  1.  ;  TIME - time to process ($H format)
  1.  ;
  1.  N C,I,J
  1.  ;cmi/maw added next 3 lines to strip |CR| off of X12 messages
  1.  I $G(BHLMIEN),$P($G(^INTHL7M(BHLMIEN,0)),U,12)="X12" D
  1.  . S (C,I)=0 F  S I=$O(@G@(I)) Q:'I  S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I),"|CR|")_$S('$O(@G@(I,0)):"",1:"") I $O(@G@(I,0)) D
  1.  .. S J=0 F  S J=$O(@G@(I,J)) Q:'J  S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I,J),"|CR|")_$S('$O(@G@(I,J)):"",1:"")
  1.  I $G(BHLMIEN),$P($G(^INTHL7M(BHLMIEN,0)),U,12)'="X12" D
  1.  . S (C,I)=0 F  S I=$O(@G@(I)) Q:'I  S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I),"|CR|")_$S('$O(@G@(I,0)):"|CR|",1:"") I $O(@G@(I,0)) D
  1.  .. S J=0 F  S J=$O(@G@(I,J)) Q:'J  S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I,J),"|CR|")_$S('$O(@G@(I,J)):"|CR|",1:"")
  1.  I '$G(BHLMIEN) D
  1.  . S (C,I)=0 F  S I=$O(@G@(I)) Q:'I  S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I),"|CR|")_$S('$O(@G@(I,0)):"|CR|",1:"") I $O(@G@(I,0)) D
  1.  .. S J=0 F  S J=$O(@G@(I,J)) Q:'J  S C=C+1,^INTHU(DA,3,C,0)=$P(@G@(I,J),"|CR|")_$S('$O(@G@(I,J)):"|CR|",1:"")
  1.  S ^INTHU(DA,3,0)="^^"_C_"^"_C
  1.  D TIME,SET(TIME,DEST,DA,$G(%OUT))
  1.  ;cmi/maw end of mods
  1.  Q
  1.  ;
  1. NEW(MID,DEST,SRC,G,ACK,DIR,%OUT,INMIDGEN) ;Make a new entry from an outside program
  1.  ;INPUT:
  1.  ;MID    = Message ID of incoming message [REQD]
  1.  ;           If ="^" then generate one and use it
  1.  ;DEST   = Name of a destination (file #4005) [REQD]
  1.  ;SRC    = Free Text source [REQD]
  1.  ;G      = Global reference of lines of data:   $G@(n) n=1,2,3,... [REQD]
  1.  ;ACK    = Acknowledge required (0 = NO, 1 = YES) [REQD]
  1.  ;DIR    = Direction (I:default = Incoming, O = Outgoing) [OPT]
  1.  ;%OUT   = Allow output controller to process (0:default = YES  1 = NO) [OPT]
  1.  ;INMIDGEN = Message ID of originating message (node 0, piece 5)
  1.  ;
  1.  ;OUTPUT:
  1.  ;Function - entry # in UIF (^INTHU) or -1 (if error)
  1.  ;
  1.  S X="ERROR^INHD",@^%ZOSF("TRAP")
  1.  N TT,DIC,TIME,DO,X,Y,DA,DIC,DD,DIE,DR,DLAYGO
  1.  I $G(DEST)=""!($G(SRC)="")!($G(G)="")!($G(ACK)="")!($G(MID)="") D FAILR Q -1
  1.  S DEST=$O(^INRHD("B",DEST,""))
  1.  I MID'="^",'DEST D FAILR Q -1
  1.  I $D(^INTHU("C",MID)) D FAILR Q -1
  1.  I MID="^" S MID=$$MESSID
  1.  S:$G(DIR)="" DIR="I" S DIR=$E(DIR) Q:"IO"'[DIR -1
  1.  S X="NOW",DLAYGO=4001,DIC="^INTHU(",DIC(0)="FL" D ^DICN
  1.  I Y<0 D FAILR Q -1
  1.  S DA=+Y L +^INTHU(DA)
  1.  N INMID,INDEST,INSRC,ING,INNEACK,INDIR,INNEOUT,INTT,INORGIEN
  1.  S INMIDGEN=$G(INMIDGEN)
  1.  S INMID=MID,INDEST=DEST,INSRC=SRC,ING=G,INNEACK=ACK,INDIR=DIR,INNEOUT=$G(%OUT),INTT="" S INORGIEN=$S('$L(INMIDGEN):"",1:$O(^INTHU("C",INMIDGEN,0)))
  1.  S DIE="^INTHU(",DR="[INH MESSAGE NEW]" D ^DIE
  1.  D STORE
  1.  L -^INTHU(DA)
  1.  Q DA
  1.  ;
  1. FAILR ;Creation of UIF entry by a receiver ( NEW ) failed
  1.  N ERROR
  1.  D ERRMES
  1.  D ENR^INHE("",.ERROR)
  1.  Q
  1. FAILO ;Creation of UIF entry by NEWO failed
  1.  N ERROR,INBZ,INBNZ
  1.  D ERRMES
  1.  ;Call appropriate erorr module
  1.  S INBZ=+$G(INBPN),INBNZ=$P($G(^INTHPC(INBZ,0)),U,1)
  1.  ;I INBZ=1 D ENO^INHE(
  1.  ;I INBZ=2 D ENF^INHE(
  1.  ;I INBNZ["RECE" D ENR^INHE("",.ERROR)
  1.  ;I INBNZ["TRANS" D ENT^INHE(
  1.  ;D ENR^INHE("",.ERROR)  ;cmi/anch/maw 9/8/2004 this is a bug
  1.  D ENR^INHE(+$G(INBPN),.ERROR)  ;cmi/anch/maw 9/8/2004 this is the fix
  1.  ;
  1.  Q
  1. ERRMES ;Set up "creation failed" error message
  1.  S ERROR(1)="UIF entry creation failed:"
  1.  S ERROR(2)=" DEST = '"_$G(DEST)_"'",ERROR(3)=" SOURCE = '"_$G(SRC)_"'",ERROR(4)=" MESS ID = '"_$G(MID)_"'",ERROR(5)=" Global Ref = '"_$G(G)_"'"
  1.  Q
  1.  ;
  1. MESSID() ;Function to return a unique Message ID
  1.  N X,Y
  1.  L +^INTHU("MESSID")
  1. M1 S X=$G(^INTHU("MESSID"))+1,^("MESSID")=X,Y=$P($G(^INRHSITE(1,0)),U,8)_X
  1.  G:$D(^INTHU("C",Y)) M1
  1.  L -^INTHU("MESSID")
  1.  Q Y
  1.  ;
  1. ERROR ;Handle errors
  1.  X ^INTHOS(1,3)
  1.  D ENI^INHE($G(TT),$G(DEST),$$ERRMSG^INHU1)   ;CHECK CALL
  1.  Q -1
  1.  ;
  1. SET(INH,IND,INU,INO,INPRIO) ;Queue an entry into ^INLHSCH
  1.  ;INPUT:
  1.  ;INH = $H format of when [REQ]
  1.  ;IND = destination entry # [REQ]
  1.  ;INU = UIF entry # [REQ]
  1.  ;INO = if defined and non-zero, suppress setting output queue [OPT]
  1.  ;INPRIO = if defined, sets processing priority [OPT]
  1.  ;TT - ien of Transaction Type
  1.  ;
  1.  Q:'$G(IND)!'$G(INU)!$G(INO)  Q:'$D(^INRHD(IND,0))!'$D(^INTHU(INU,0))
  1.  N H,INP,X,Y,DIE,DR,DA,TT0,INDELQ
  1.  ;Determine destination queue
  1.  S INDELQ=$P(^INRHD(IND,0),U,12)
  1.  S H=$P(INH,",",2) I $L(H)<5 S H=$E("00000",1,5-$L(H))_H
  1.  S INH=$P(INH,",")_","_H
  1.  ;Housekeeping messages may have no TT
  1.  S TT0=$S('$D(TT):"",TT:^INRHT(TT,0),1:"")
  1.  S INP=$S($D(INPRIO):+INPRIO,$L(TT0):+$P(TT0,U,16),1:0)
  1.  S DR=".16////"_INP_";.19////"_INH,DIE="^INTHU(",DA=INU D ^DIE
  1.  ;Place in destination queue AND exit
  1.  I INDELQ S ^INLHDEST(IND,INP,INH,INU)="" Q
  1.  ;Defaul to OUTPUT CONTROLLER queue
  1.  S ^INLHSCH(INP,INH,INU)=""
  1.  Q
  1.  ;
  1. TIME ;Get time to process. If STAT, set to 00000,00000
  1.  ;INPUT:
  1.  ;  DEST - ien of destination (req)
  1.  ;  TT - ien of transaction type (optional)
  1.  ;OUTPUT:
  1.  ;  TT - ien of Transaction Type
  1.  ;  TIME - time to process
  1.  N TTP
  1.  ;if outgoing, TT is defined. If incoming, get from destination
  1.  I '$D(TT) S TT=$P(^INRHD(DEST,0),U,2)
  1.  I 'TT S TIME=$H Q
  1.  S TTP=$P(^INRHT(TT,0),U,15)
  1.  I TTP="" S TIME=$H Q
  1.  I TTP="STAT" S TIME="00000,00000" Q
  1.  ;Handle relative times (ex. NOW+30S)
  1.  I TTP["NOW",TTP["+" D
  1.  .  N %,P,T S T=$P(TTP,"+",2)
  1.  .  ;Only one measure (D,H,M, or S) is supported
  1.  .  F %="S","M","H","D" I T[% S P(%)=+T Q
  1.  .  S TTP=$$ADDT^%ZTFDT($$NOW^%ZTFDT,$G(P("D")),$G(P("H")),$G(P("M")),$G(P("S")))
  1.  N X,Y,%DT S X=TTP,%DT="TRS" D ^%DT S TIME=$$CDATF2H^UTDT(Y)
  1.  S:TIME<0 TIME=$H
  1.  Q