SCDXMSG ;ALB/JRP - AMB CARE TRANSMISSION BUILDER ;05/06/96
;;5.3;SCHEDULING;**44,56,70,77,85,96,121,128,66,247,245,387,466,640**;AUG 13, 1993;Build 8
;
SNDZ00 ;Main entry point for the sending of ADT-Z00 batch messages to
; the National Patient Care Database
;
;Input : None
;Output : None
;
; SD*640 Stop sending nightly transmission to NPCDB.
Q
;
SD70 ; added w/ patch SD*5.3*70 to reset transmit flags if needed
N SDEND,SDSTA D EN^SCDXUTL5
;
;Declare variables
N X,X1,X2,%H
N XMITPTR,NOACKBY,XMITDATE,SCDXEVNT,MAXBATCH,MAXLINE,BATCHCNT,MSGNUM
N LINECNT,MSHLINE,XMITLIST,XMITERR,HL7XMIT,ERROR,IPCNT
N HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
;Set message count limit for batch message
S MAXBATCH=100
;Set line count limit for batch message Note max 160K char. MM Message
S MAXLINE=$P($G(^SD(404.91,1,"AMB")),U,8) S:'MAXLINE MAXLINE=2000
;Initialize global locations
S XMITERR="^TMP(""SCDX-XMIT-BLD"","_$J_",""ERRORS"")"
S HL7XMIT="^TMP(""HLS"","_$J_")"
K @XMITERR,@HL7XMIT
;Get lag time for acks from NPCDB (default to T-LAG)
S NOACKBY=+$P($G(^SD(404.91,1,"AMB")),"^",4)
S:('NOACKBY) NOACKBY=2
;Determine T-LAG @ 11:59:59 PM
S X1=$$DT^XLFDT()
S X2=0-NOACKBY
S NOACKBY=$$FMADD^XLFDT(X1,X2)_".235959"
;Flag transmissions that haven't been acked by T-LAG for retransmission
S XMITDATE=""
F S XMITDATE=+$O(^SD(409.73,"AACNOACK",XMITDATE)) Q:(('XMITDATE)!(XMITDATE>NOACKBY)) D
.S XMITPTR=""
.F S XMITPTR=+$O(^SD(409.73,"AACNOACK",XMITDATE,XMITPTR)) Q:('XMITPTR) D
..;Mark entry with retransmit event (POSTMASTER is causer of event)
..D STREEVNT^SCDXFU01(XMITPTR,0,"",.5)
..;Can no longer receive database credit - delete x-ref and quit
..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 K ^SD(409.73,"AACNOACK",XMITDATE,XMITPTR) Q ;SD*5.3*247
..;Turn transmission flag on
..D XMITFLAG^SCDXFU01(XMITPTR)
;Get pointer to sending event
S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
;Sending event not found - send error bulletin - done
I ('HLEID) D ERRBULL^SCDXMSG2("Unable to initialize HL7 variables - protocol not found") Q
;Initialze HL7 variables
D INIT^HLFNC2(HLEID,.HL)
;Unable to initialize HL7 variables - send error bulletin - done
I ($O(HL(""))="") D ERRBULL^SCDXMSG2($P(HL,"^",2)) Q
;Create batch message
D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
;Unable to create batch message - send error bulletin - done
I ('HLMTIEN) D ERRBULL^SCDXMSG2("Unable to create batch HL7 message") Q
;Initialize message count
S BATCHCNT=0,IPCNT=0
;Initialize message number
S MSGNUM=1
;Initialize line count
S LINECNT=1
N VALER,VALERR
;this global contains the validation errors if any.
S VALER="^TMP(""SCDXVALID"",$J)"
;Loop through list of [deleted] encounters requiring transmission
S SCDXEVNT=""
F S SCDXEVNT=+$O(^SD(409.73,"AACXMIT",SCDXEVNT)) Q:('SCDXEVNT) D
.S XMITPTR=""
.F S XMITPTR=+$O(^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR)) Q:('XMITPTR) D
..N OENODE,PARENT,FILERR
..S VALERR="^TMP(""SCDXVALID"",$J,"_XMITPTR_")"
..;Bad entry in cross reference - delete cross reference and quit
..I ('$D(^SD(409.73,XMITPTR))) K ^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR) Q
..;Make sure entry points to an existing encounter - delete entry
..; and quit if it doesn't
..S X=^SD(409.73,XMITPTR,0)
..S X1=+$P(X,"^",2)
..S X2=+$P(X,"^",3)
..S OENODE=$S($G(^SCE(+X1,0)):^(0),1:$G(^SD(409.74,+X2,1))),PARENT=$P(OENODE,"^",6)
..I (((X1)&('$D(^SCE(X1))))!((X2)&('$D(^SD(409.74,X2))))) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
..; if SD*5.3*70 cleanup not complete, recheck date of encounter for range
..I $G(SDEND) Q:$$CHKD(X1,X2)
..;If inpatient appointment, delete entry and quit
..;Commented to allow transmission of inpatient to NPCD; SD*5.3*387
..;I ($$INPATENC^SCDXUTL(XMITPTR)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
..;If test patient, delete entry and quit
..I $$TESTPAT^VADPT($P($$EZN4XMIT^SCDXFU11(XMITPTR),"^",2)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
..;If child encounter, delete entry, flag parent for xmit, and quit
..I PARENT D Q
...S ERROR=$$DELXMIT^SCDXFU03(XMITPTR)
..;NPCD will not accept for database credit - clean up and quit
..I +$$XMIT4DBC^SCDXFU04(XMITPTR)>3 D Q ;SD*5.3*247
...;Past database close-out date - delete previously reported errors
...D DELAERR^SCDXFU02(XMITPTR)
...;Turn off transmission flag
...D XMITFLAG^SCDXFU01(XMITPTR,1)
..;Calculate message control ID
..S MSGID=HLMID_"-"_MSGNUM
..;Put [deleted] encounter into transmission
..S ERROR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,MSGID,HL7XMIT,LINECNT,VALERR)
..;[Deleted] encounter not added to transmission
..I ERROR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
..D DELAERR^SCDXFU02(XMITPTR,0)
..I $O(@VALERR@(0))]"" S FILERR=$$FILEVERR^SCMSVUT2(XMITPTR,VALERR)
..I ERROR<0 Q
..;Increment line count
..S LINECNT=LINECNT+ERROR
..;Increment message count
..S BATCHCNT=BATCHCNT+1
..;Increment message number
..S MSGNUM=MSGNUM+1
..;Increment inpatient count
..I $$INPATENC^SCDXUTL(XMITPTR) S IPCNT=IPCNT+1
..;Create entry in ACRP Transmission History file (#409.77)
..S X=$$CRTHIST^SCDXFU10(XMITPTR,HLDT,MSGID,HLMID)
..;Update transmission info for [deleted] encounter
..D XMITDATA^SCDXFU03(XMITPTR,HLDT,MSGID,HLMID)
..;Turn off transmission flag for [deleted] encounter
..D XMITFLAG^SCDXFU01(XMITPTR,1)
..;Delete all errors previously reported for [deleted] encounter
..D DELAERR^SCDXFU02(XMITPTR)
..;Reached max size for batch
..I ((MSGNUM>MAXBATCH)!(LINECNT>MAXLINE)) D
...;Send batch message - immediate priority
...S HLP("PRIORITY")="I"
...D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
...;Re-initialize HL7 message
...K @HL7XMIT
...;Re-initialize HL7 variables
...K HL,HLRESLT,HLP,HLMID,HLMTIEN,HLDT,HLDT1
...S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
...D INIT^HLFNC2(HLEID,.HL)
...;Create new batch message
...D CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
...;Re-initialize line count
...S LINECNT=1
...;Re-initialize message number
...S MSGNUM=1
;Check for unsent batch message
I ($O(@HL7XMIT@(0))) D
.;Send batch message - immediate priority
.S HLP("PRIORITY")="I"
.D GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
N ERRCNT,IPERR
S ERRCNT=$$COUNT^SCMSVUT2(VALER)
S IPERR=$$IPERR^SCMSVUT2(VALER)
;Send completion bulletin
D CMPLBULL^SCDXMSG2(BATCHCNT,ERRCNT,IPCNT,IPERR)
;Clean up global arrays used
K @XMITERR,@HL7XMIT,@VALER
;Determine if updating of Hospital Location file hasn't completed AND
; if today is past the OPC to HL7 cut over date
I ('$P($G(^SD(404.91,1,"AMB")),"^",7)) I ($$DATE^SCDXUTL(DT)) D
.;Task updating of Hospital Location file
.N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
.S ZTRTN="HOPUP^SCMSP"
.S ZTDESC="REQUIRE PROVIDER AND DIAGNOSIS FOR CHECKOUT FROM CLINICS"
.S ZTDTH="NOW"
.S ZTIO=""
.D ^%ZTLOAD
;Done
Q
;
CHKD(X1,X2) ; if clean-up still in progress for SD*5.3*70, check date
N SDELE
I X1,+$G(^SCE(X1,0))>SDEND Q 1
I X2 S SDELE=+$G(^SD(409.74,X2,1)) I SDELE>SDSTA D:SDELE<SDEND Q 1
. D KILL^SCDXUTL5("^SD(409.74,",X2)
. D KILL^SCDXUTL5("^SD(409.73,",XMITPTR)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXMSG 7285 printed Nov 22, 2024@17:49:15 Page 2
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
+2 ;
SNDZ00 ;Main entry point for the sending of ADT-Z00 batch messages to
+1 ; the National Patient Care Database
+2 ;
+3 ;Input : None
+4 ;Output : None
+5 ;
+6 ; SD*640 Stop sending nightly transmission to NPCDB.
+7 QUIT
+8 ;
SD70 ; added w/ patch SD*5.3*70 to reset transmit flags if needed
+1 NEW SDEND,SDSTA
DO EN^SCDXUTL5
+2 ;
+3 ;Declare variables
+4 NEW X,X1,X2,%H
+5 NEW XMITPTR,NOACKBY,XMITDATE,SCDXEVNT,MAXBATCH,MAXLINE,BATCHCNT,MSGNUM
+6 NEW LINECNT,MSHLINE,XMITLIST,XMITERR,HL7XMIT,ERROR,IPCNT
+7 NEW HLEID,HL,HLECH,HLFS,HLQ,HLMID,HLMTIEN,HLDT,HLDT1,MSGID,HLRESLT,HLP
+8 ;Set message count limit for batch message
+9 SET MAXBATCH=100
+10 ;Set line count limit for batch message Note max 160K char. MM Message
+11 SET MAXLINE=$PIECE($GET(^SD(404.91,1,"AMB")),U,8)
if 'MAXLINE
SET MAXLINE=2000
+12 ;Initialize global locations
+13 SET XMITERR="^TMP(""SCDX-XMIT-BLD"","_$JOB_",""ERRORS"")"
+14 SET HL7XMIT="^TMP(""HLS"","_$JOB_")"
+15 KILL @XMITERR,@HL7XMIT
+16 ;Get lag time for acks from NPCDB (default to T-LAG)
+17 SET NOACKBY=+$PIECE($GET(^SD(404.91,1,"AMB")),"^",4)
+18 if ('NOACKBY)
SET NOACKBY=2
+19 ;Determine T-LAG @ 11:59:59 PM
+20 SET X1=$$DT^XLFDT()
+21 SET X2=0-NOACKBY
+22 SET NOACKBY=$$FMADD^XLFDT(X1,X2)_".235959"
+23 ;Flag transmissions that haven't been acked by T-LAG for retransmission
+24 SET XMITDATE=""
+25 FOR
SET XMITDATE=+$ORDER(^SD(409.73,"AACNOACK",XMITDATE))
if (('XMITDATE)!(XMITDATE>NOACKBY))
QUIT
Begin DoDot:1
+26 SET XMITPTR=""
+27 FOR
SET XMITPTR=+$ORDER(^SD(409.73,"AACNOACK",XMITDATE,XMITPTR))
if ('XMITPTR)
QUIT
Begin DoDot:2
+28 ;Mark entry with retransmit event (POSTMASTER is causer of event)
+29 DO STREEVNT^SCDXFU01(XMITPTR,0,"",.5)
+30 ;Can no longer receive database credit - delete x-ref and quit
+31 ;SD*5.3*247
IF +$$XMIT4DBC^SCDXFU04(XMITPTR)>3
KILL ^SD(409.73,"AACNOACK",XMITDATE,XMITPTR)
QUIT
+32 ;Turn transmission flag on
+33 DO XMITFLAG^SCDXFU01(XMITPTR)
End DoDot:2
End DoDot:1
+34 ;Get pointer to sending event
+35 SET HLEID=+$ORDER(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
+36 ;Sending event not found - send error bulletin - done
+37 IF ('HLEID)
DO ERRBULL^SCDXMSG2("Unable to initialize HL7 variables - protocol not found")
QUIT
+38 ;Initialze HL7 variables
+39 DO INIT^HLFNC2(HLEID,.HL)
+40 ;Unable to initialize HL7 variables - send error bulletin - done
+41 IF ($ORDER(HL(""))="")
DO ERRBULL^SCDXMSG2($PIECE(HL,"^",2))
QUIT
+42 ;Create batch message
+43 DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
+44 ;Unable to create batch message - send error bulletin - done
+45 IF ('HLMTIEN)
DO ERRBULL^SCDXMSG2("Unable to create batch HL7 message")
QUIT
+46 ;Initialize message count
+47 SET BATCHCNT=0
SET IPCNT=0
+48 ;Initialize message number
+49 SET MSGNUM=1
+50 ;Initialize line count
+51 SET LINECNT=1
+52 NEW VALER,VALERR
+53 ;this global contains the validation errors if any.
+54 SET VALER="^TMP(""SCDXVALID"",$J)"
+55 ;Loop through list of [deleted] encounters requiring transmission
+56 SET SCDXEVNT=""
+57 FOR
SET SCDXEVNT=+$ORDER(^SD(409.73,"AACXMIT",SCDXEVNT))
if ('SCDXEVNT)
QUIT
Begin DoDot:1
+58 SET XMITPTR=""
+59 FOR
SET XMITPTR=+$ORDER(^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR))
if ('XMITPTR)
QUIT
Begin DoDot:2
+60 NEW OENODE,PARENT,FILERR
+61 SET VALERR="^TMP(""SCDXVALID"",$J,"_XMITPTR_")"
+62 ;Bad entry in cross reference - delete cross reference and quit
+63 IF ('$DATA(^SD(409.73,XMITPTR)))
KILL ^SD(409.73,"AACXMIT",SCDXEVNT,XMITPTR)
QUIT
+64 ;Make sure entry points to an existing encounter - delete entry
+65 ; and quit if it doesn't
+66 SET X=^SD(409.73,XMITPTR,0)
+67 SET X1=+$PIECE(X,"^",2)
+68 SET X2=+$PIECE(X,"^",3)
+69 SET OENODE=$SELECT($GET(^SCE(+X1,0)):^(0),1:$GET(^SD(409.74,+X2,1)))
SET PARENT=$PIECE(OENODE,"^",6)
+70 IF (((X1)&('$DATA(^SCE(X1))))!((X2)&('$DATA(^SD(409.74,X2)))))
SET ERROR=$$DELXMIT^SCDXFU03(XMITPTR)
QUIT
+71 ; if SD*5.3*70 cleanup not complete, recheck date of encounter for range
+72 IF $GET(SDEND)
if $$CHKD(X1,X2)
QUIT
+73 ;If inpatient appointment, delete entry and quit
+74 ;Commented to allow transmission of inpatient to NPCD; SD*5.3*387
+75 ;I ($$INPATENC^SCDXUTL(XMITPTR)) S ERROR=$$DELXMIT^SCDXFU03(XMITPTR) Q
+76 ;If test patient, delete entry and quit
+77 IF $$TESTPAT^VADPT($PIECE($$EZN4XMIT^SCDXFU11(XMITPTR),"^",2))
SET ERROR=$$DELXMIT^SCDXFU03(XMITPTR)
QUIT
+78 ;If child encounter, delete entry, flag parent for xmit, and quit
+79 IF PARENT
Begin DoDot:3
+80 SET ERROR=$$DELXMIT^SCDXFU03(XMITPTR)
End DoDot:3
QUIT
+81 ;NPCD will not accept for database credit - clean up and quit
+82 ;SD*5.3*247
IF +$$XMIT4DBC^SCDXFU04(XMITPTR)>3
Begin DoDot:3
+83 ;Past database close-out date - delete previously reported errors
+84 DO DELAERR^SCDXFU02(XMITPTR)
+85 ;Turn off transmission flag
+86 DO XMITFLAG^SCDXFU01(XMITPTR,1)
End DoDot:3
QUIT
+87 ;Calculate message control ID
+88 SET MSGID=HLMID_"-"_MSGNUM
+89 ;Put [deleted] encounter into transmission
+90 SET ERROR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,MSGID,HL7XMIT,LINECNT,VALERR)
+91 ;[Deleted] encounter not added to transmission
+92 IF ERROR<0
IF $ORDER(@VALERR@(0))']""
DO VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
+93 DO DELAERR^SCDXFU02(XMITPTR,0)
+94 IF $ORDER(@VALERR@(0))]""
SET FILERR=$$FILEVERR^SCMSVUT2(XMITPTR,VALERR)
+95 IF ERROR<0
QUIT
+96 ;Increment line count
+97 SET LINECNT=LINECNT+ERROR
+98 ;Increment message count
+99 SET BATCHCNT=BATCHCNT+1
+100 ;Increment message number
+101 SET MSGNUM=MSGNUM+1
+102 ;Increment inpatient count
+103 IF $$INPATENC^SCDXUTL(XMITPTR)
SET IPCNT=IPCNT+1
+104 ;Create entry in ACRP Transmission History file (#409.77)
+105 SET X=$$CRTHIST^SCDXFU10(XMITPTR,HLDT,MSGID,HLMID)
+106 ;Update transmission info for [deleted] encounter
+107 DO XMITDATA^SCDXFU03(XMITPTR,HLDT,MSGID,HLMID)
+108 ;Turn off transmission flag for [deleted] encounter
+109 DO XMITFLAG^SCDXFU01(XMITPTR,1)
+110 ;Delete all errors previously reported for [deleted] encounter
+111 DO DELAERR^SCDXFU02(XMITPTR)
+112 ;Reached max size for batch
+113 IF ((MSGNUM>MAXBATCH)!(LINECNT>MAXLINE))
Begin DoDot:3
+114 ;Send batch message - immediate priority
+115 SET HLP("PRIORITY")="I"
+116 DO GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
+117 ;Re-initialize HL7 message
+118 KILL @HL7XMIT
+119 ;Re-initialize HL7 variables
+120 KILL HL,HLRESLT,HLP,HLMID,HLMTIEN,HLDT,HLDT1
+121 SET HLEID=+$ORDER(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
+122 DO INIT^HLFNC2(HLEID,.HL)
+123 ;Create new batch message
+124 DO CREATE^HLTF(.HLMID,.HLMTIEN,.HLDT,.HLDT1)
+125 ;Re-initialize line count
+126 SET LINECNT=1
+127 ;Re-initialize message number
+128 SET MSGNUM=1
End DoDot:3
End DoDot:2
End DoDot:1
+129 ;Check for unsent batch message
+130 IF ($ORDER(@HL7XMIT@(0)))
Begin DoDot:1
+131 ;Send batch message - immediate priority
+132 SET HLP("PRIORITY")="I"
+133 DO GENERATE^HLMA(HLEID,"GB",1,.HLRESLT,HLMTIEN,.HLP)
End DoDot:1
+134 NEW ERRCNT,IPERR
+135 SET ERRCNT=$$COUNT^SCMSVUT2(VALER)
+136 SET IPERR=$$IPERR^SCMSVUT2(VALER)
+137 ;Send completion bulletin
+138 DO CMPLBULL^SCDXMSG2(BATCHCNT,ERRCNT,IPCNT,IPERR)
+139 ;Clean up global arrays used
+140 KILL @XMITERR,@HL7XMIT,@VALER
+141 ;Determine if updating of Hospital Location file hasn't completed AND
+142 ; if today is past the OPC to HL7 cut over date
+143 IF ('$PIECE($GET(^SD(404.91,1,"AMB")),"^",7))
IF ($$DATE^SCDXUTL(DT))
Begin DoDot:1
+144 ;Task updating of Hospital Location file
+145 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
+146 SET ZTRTN="HOPUP^SCMSP"
+147 SET ZTDESC="REQUIRE PROVIDER AND DIAGNOSIS FOR CHECKOUT FROM CLINICS"
+148 SET ZTDTH="NOW"
+149 SET ZTIO=""
+150 DO ^%ZTLOAD
End DoDot:1
+151 ;Done
+152 QUIT
+153 ;
CHKD(X1,X2) ; if clean-up still in progress for SD*5.3*70, check date
+1 NEW SDELE
+2 IF X1
IF +$GET(^SCE(X1,0))>SDEND
QUIT 1
+3 IF X2
SET SDELE=+$GET(^SD(409.74,X2,1))
IF SDELE>SDSTA
if SDELE<SDEND
Begin DoDot:1
+4 DO KILL^SCDXUTL5("^SD(409.74,",X2)
+5 DO KILL^SCDXUTL5("^SD(409.73,",XMITPTR)
End DoDot:1
QUIT 1
+6 QUIT 0
