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

SCDXMSG.m

Go to the documentation of this file. 
  1. SCDXMSG ;ALB/JRP - AMB CARE TRANSMISSION BUILDER ;05/06/96
  1.  ;;5.3;SCHEDULING;**44,56,70,77,85,96,121,128,66,247,245,387,466,640**;AUG 13, 1993;Build 8
  1.  ;
  1. SNDZ00 ;Main entry point for the sending of ADT-Z00 batch messages to
  1.  ; the National Patient Care Database
  1.  ;
  1.  ;Input  : None
  1.  ;Output : None
  1.  ;
  1.  ; SD*640 Stop sending nightly transmission to NPCDB.
  1.  Q
  1.  ;
  1. SD70 ; added w/ patch SD*5.3*70 to reset transmit flags if needed
  1.  N SDEND,SDSTA D EN^SCDXUTL5
  1.  ;
  1.  ;Declare variables
  1.  N X,X1,X2,%H
  1.  N XMITPTR,NOACKBY,XMITDATE,SCDXEVNT,MAXBATCH,MAXLINE,BATCHCNT,MSGNUM
  1.  N LINECNT,MSHLINE,XMITLIST,XMITERR,HL7XMIT,ERROR,IPCNT
  1.  N HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
  1.  ;Set message count limit for batch message
  1.  S MAXBATCH=100
  1.  ;Set line count limit for batch message Note max 160K char. MM Message
  1.  S MAXLINE=$P($G(^SD(404.91,1,"AMB")),U,8) S:'MAXLINE MAXLINE=2000
  1.  ;Initialize global locations
  1.  S XMITERR="^TMP(""SCDX-XMIT-BLD"","_$J_",""ERRORS"")"
  1.  S HL7XMIT="^TMP(""HLS"","_$J_")"
  1.  K @XMITERR,@HL7XMIT
  1.  ;Get lag time for acks from NPCDB (default to T-LAG)
  1.  S NOACKBY=+$P($G(^SD(404.91,1,"AMB")),"^",4)
  1.  S:('NOACKBY) NOACKBY=2
  1.  ;Determine T-LAG @ 11:59:59 PM
  1.  S X1=$$DT^XLFDT()
  1.  S X2=0-NOACKBY
  1.  S NOACKBY=$$FMADD^XLFDT(X1,X2)_".235959"
  1.  ;Flag transmissions that haven't been acked by T-LAG for retransmission
  1.  S XMITDATE=""
  1.  F  S XMITDATE=+$O(^SD(409.73,"AACNOACK",XMITDATE)) Q:(('XMITDATE)!(XMITDATE>NOACKBY))  D
  1.  .S XMITPTR=""
  1.  .F  S XMITPTR=+$O(^SD(409.73,"AACNOACK",XMITDATE,XMITPTR)) Q:('XMITPTR)  D
  1.  ..;Mark entry with retransmit event (POSTMASTER is causer of event)
  1.  ..D STREEVNT^SCDXFU01(XMITPTR,0,"",.5)
  1.  ..;Can no longer receive database credit - delete x-ref and quit
  1.  ..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 K ^SD(409.73,"AACNOACK",XMITDATE,XMITPTR) Q  ;SD*5.3*247
  1.  ..;Turn transmission flag on
  1.  ..D XMITFLAG^SCDXFU01(XMITPTR)
  1.  ;Get pointer to sending event
  1.  S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
  1.  ;Sending event not found - send error bulletin - done
  1.  I ('HLEID) D ERRBULL^SCDXMSG2("Unable to initialize HL7 variables - protocol not found") Q
  1.  ;Initialze HL7 variables
  1.  D INIT^HLFNC2(HLEID,.HL)
  1.  ;Unable to initialize HL7 variables - send error bulletin - done
  1.  I ($O(HL(""))="") D ERRBULL^SCDXMSG2($P(HL,"^",2)) Q
  1.  ;Create batch message
  1.  D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
  1.  ;Unable to create batch message - send error bulletin - done
  1.  I ('HLMTIEN) D ERRBULL^SCDXMSG2("Unable to create batch HL7 message") Q
  1.  ;Initialize message count
  1.  S BATCHCNT=0,IPCNT=0
  1.  ;Initialize message number
  1.  S MSGNUM=1
  1.  ;Initialize line count
  1.  S LINECNT=1
  1.  N VALER,VALERR
  1.  ;this global contains the validation errors if any.
  1.  S VALER="^TMP(""SCDXVALID"",$J)"
  1.  ;Loop through list of [deleted] encounters requiring transmission
  1.  S SCDXEVNT=""
  1.  F  S SCDXEVNT=+$O(^SD(409.73,"AACXMIT",SCDXEVNT)) Q:('SCDXEVNT)  D
  1.  .S XMITPTR=""
  1.  .F  S XMITPTR=+$O(^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR)) Q:('XMITPTR)  D
  1.  ..N OENODE,PARENT,FILERR
  1.  ..S VALERR="^TMP(""SCDXVALID"",$J,"_XMITPTR_")"
  1.  ..;Bad entry in cross reference - delete cross reference and quit
  1.  ..I ('$D(^SD(409.73,XMITPTR))) K ^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR) Q
  1.  ..;Make sure entry points to an existing encounter - delete entry
  1.  ..; and quit if it doesn't
  1.  ..S X=^SD(409.73,XMITPTR,0)
  1.  ..S X1=+$P(X,"^",2)
  1.  ..S X2=+$P(X,"^",3)
  1.  ..S OENODE=$S($G(^SCE(+X1,0)):^(0),1:$G(^SD(409.74,+X2,1))),PARENT=$P(OENODE,"^",6)
  1.  ..I (((X1)&('$D(^SCE(X1))))!((X2)&('$D(^SD(409.74,X2))))) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
  1.  ..; if SD*5.3*70 cleanup not complete, recheck date of encounter for range
  1.  ..I $G(SDEND) Q:$$CHKD(X1,X2)
  1.  ..;If inpatient appointment, delete entry and quit
  1.  ..;Commented to allow transmission of inpatient to NPCD; SD*5.3*387
  1.  ..;I ($$INPATENC^SCDXUTL(XMITPTR)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
  1.  ..;If test patient, delete entry and quit
  1.  ..I $$TESTPAT^VADPT($P($$EZN4XMIT^SCDXFU11(XMITPTR),"^",2)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
  1.  ..;If child encounter, delete entry, flag parent for xmit, and quit
  1.  ..I PARENT D  Q
  1.  ...S ERROR=$$DELXMIT^SCDXFU03(XMITPTR)
  1.  ..;NPCD will not accept for database credit - clean up and quit
  1.  ..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 D  Q  ;SD*5.3*247
  1.  ...;Past database close-out date - delete previously reported errors
  1.  ...D DELAERR^SCDXFU02(XMITPTR)
  1.  ...;Turn off transmission flag
  1.  ...D XMITFLAG^SCDXFU01(XMITPTR,1)
  1.  ..;Calculate message control ID
  1.  ..S MSGID=HLMID_"-"_MSGNUM
  1.  ..;Put [deleted] encounter into transmission
  1.  ..S ERROR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,MSGID,HL7XMIT,LINECNT,VALERR)
  1.  ..;[Deleted] encounter not added to transmission
  1.  ..I ERROR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
  1.  ..D DELAERR^SCDXFU02(XMITPTR,0)
  1.  ..I $O(@VALERR@(0))]"" S FILERR=$$FILEVERR^SCMSVUT2(XMITPTR,VALERR)
  1.  ..I ERROR<0 Q
  1.  ..;Increment line count
  1.  ..S LINECNT=LINECNT+ERROR
  1.  ..;Increment message count
  1.  ..S BATCHCNT=BATCHCNT+1
  1.  ..;Increment message number
  1.  ..S MSGNUM=MSGNUM+1
  1.  ..;Increment inpatient count
  1.  ..I $$INPATENC^SCDXUTL(XMITPTR) S IPCNT=IPCNT+1
  1.  ..;Create entry in ACRP Transmission History file (#409.77)
  1.  ..S X=$$CRTHIST^SCDXFU10(XMITPTR,HLDT,MSGID,HLMID)
  1.  ..;Update transmission info for [deleted] encounter
  1.  ..D XMITDATA^SCDXFU03(XMITPTR,HLDT,MSGID,HLMID)
  1.  ..;Turn off transmission flag for [deleted] encounter
  1.  ..D XMITFLAG^SCDXFU01(XMITPTR,1)
  1.  ..;Delete all errors previously reported for [deleted] encounter
  1.  ..D DELAERR^SCDXFU02(XMITPTR)
  1.  ..;Reached max size for batch
  1.  ..I ((MSGNUM>MAXBATCH)!(LINECNT>MAXLINE)) D
  1.  ...;Send batch message - immediate priority
  1.  ...S HLP("PRIORITY")="I"
  1.  ...D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
  1.  ...;Re-initialize HL7 message
  1.  ...K @HL7XMIT
  1.  ...;Re-initialize HL7 variables
  1.  ...K HL,HLRESLT,HLP,HLMID,HLMTIEN,HLDT,HLDT1
  1.  ...S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
  1.  ...D INIT^HLFNC2(HLEID,.HL)
  1.  ...;Create new batch message
  1.  ...D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
  1.  ...;Re-initialize line count
  1.  ...S LINECNT=1
  1.  ...;Re-initialize message number
  1.  ...S MSGNUM=1
  1.  ;Check for unsent batch message
  1.  I ($O(@HL7XMIT@(0))) D
  1.  .;Send batch message - immediate priority
  1.  .S HLP("PRIORITY")="I"
  1.  .D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
  1.  N ERRCNT,IPERR
  1.  S ERRCNT=$$COUNT^SCMSVUT2(VALER)
  1.  S IPERR=$$IPERR^SCMSVUT2(VALER)
  1.  ;Send completion bulletin
  1.  D CMPLBULL^SCDXMSG2(BATCHCNT,ERRCNT,IPCNT,IPERR)
  1.  ;Clean up global arrays used
  1.  K @XMITERR,@HL7XMIT,@VALER
  1.  ;Determine if updating of Hospital Location file hasn't completed AND
  1.  ; if today is past the OPC to HL7 cut over date
  1.  I ('$P($G(^SD(404.91,1,"AMB")),"^",7)) I ($$DATE^SCDXUTL(DT)) D
  1.  .;Task updating of Hospital Location file
  1.  .N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
  1.  .S ZTRTN="HOPUP^SCMSP"
  1.  .S ZTDESC="REQUIRE PROVIDER AND DIAGNOSIS FOR CHECKOUT FROM CLINICS"
  1.  .S ZTDTH="NOW"
  1.  .S ZTIO=""
  1.  .D ^%ZTLOAD
  1.  ;Done
  1.  Q
  1.  ;
  1. CHKD(X1,X2) ; if clean-up still in progress for SD*5.3*70, check date
  1.  N SDELE
  1.  I X1,+$G(^SCE(X1,0))>SDEND Q 1
  1.  I X2 S SDELE=+$G(^SD(409.74,X2,1)) I SDELE>SDSTA D:SDELE<SDEND  Q 1
  1.  . D KILL^SCDXUTL5("^SD(409.74,",X2)
  1.  . D KILL^SCDXUTL5("^SD(409.73,",XMITPTR)
  1.  Q 0