DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 11/7/07 3:49pm
;;5.3;Registration;**190,312,357,762**;Aug 13, 1993;Build 3
;
EN ; Main Entry point for patient demographic update to COTS system
;
L +^XTMP("ADT/HL7 MDS COTS UPDATE"):3 E Q
;
; Check for HL7 send parameter
Q:'$P($$SEND^VAFHUTL(),"^",2)
;
; Look for patient demographic changes monitored by the COTS system
N PVTPTR,DGNODE,DFN,DGDATE,DGARRAY,DGUSR,DGRSLT
;
S DGARRAY="^TMP(""DGRAI"",""EVNTINFO"","_$J_")"
K @DGARRAY
;
; Begin looking for entries needing transmission with a type of "COTS UPDATE", Code 6.
S PVTPTR=0
F S PVTPTR=+$O(^VAT(391.71,"AXMIT",6,PVTPTR)) Q:('PVTPTR) D
. ; If no entry for xref (out of sync) delete the xref and quit
. I ('$D(^VAT(391.71,PVTPTR))) K ^VAT(391.71,"AXMIT",6,PVTPTR) Q
. ; Get event date and pointer to patient for entry
. S DGNODE=$G(^VAT(391.71,PVTPTR,0))
. S DFN=+$P(DGNODE,"^",3)
. S EVNTDT=+DGNODE
. ; Check for patient, if not valid, then mark as transmitted and quit
. I ('$D(^DPT(DFN,0))) D XMITFLAG^VAFCDD01(PVTPTR,"",1) Q
. N VAIN D INP^VADPT ; p-762
. I '$$CHKWARD^DGRUUTL(+VAIN(4)) D XMITFLAG^VAFCDD01(PVTPTR,"",1) K VAIN Q ; P-762
. K @DGARRAY
. S @DGARRAY@("PIVOT")=PVTPTR
. S @DGARRAY@("REASON",1)=""
. I (+$G(^DPT(DFN,.35))) S @DGARRAY@("REASON",1)=99
. ;
. S @DGARRAY@("USER")=$$GET1^DIQ(200,+$P(DGNODE,"^",9),.01)
. ;
. S @DGARRAY@("EVENT-NUM")=$P(DGNODE,"^",2)
. S @DGARRAY@("VAR-PTR")=$P(DGNODE,"^",5)
. ;
. S DGRSLT=$$BLDA08(DFN,EVNTDT,DGARRAY)
. I (DGRSLT<0) D ERRBUL(DGARRAY,DGRSLT) ;deleted Q p-357
. ;
. ; Mark entry in pivot file as transmitted
. D XMITFLAG^VAFCDD01(PVTPTR,"",1)
;
L -^XTMP("ADT/HL7 MDS COTS UPDATE")
Q
;
BLDA08(DFN,EVNTDT,EVNTINFO,DGDC,DGOSSN) ;
;
N RESULT,DGTMP,GLOREF
;
S DFN=+$G(DFN)
I ('$D(^DPT(DFN,0))) S RESULT="-1^Could not find entry in PATIENT file" G BLDQ
;
S DGDC=$G(DGDC)
S DGOSSN=$G(DGOSSN)
S EVNTDT=$G(EVNTDT)
S:('EVNTDT) EVNTDT=$$NOW^XLFDT
;
S GLOREF="^TMP(""HLS"","_$J_")"
K @GLOREF
;
S @EVNTINFO@("DFN")=DFN
S @EVNTINFO@("EVENT")="A08"
S @EVNTINFO@("DATE")=EVNTDT
;
N HLEID,HL,HLFS,HLECH,HLQ,NDX
;
K HL
D INIT^HLFNC2("DGRU-PATIENT-A08-SERVER",.HL)
;
I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ
;
; Build segment array
D EN^DGRUGA08(DFN,"","DGTMP",DGDC,DGOSSN)
I '$O(DGTMP(0)) S RESULT="-1^Unable to build segment list to transmit" G BLDQ
;Check segment list for errors
S NDX=0
F S NDX=$O(DGTMP(NDX)) Q:'NDX D G:(+$G(RESULT)<0) BLDQ
. I +DGTMP(NDX)<0 S RESULT="-1^An error occurred in one of the segments"
;
M @GLOREF=DGTMP
S RESULT=$$SENDMSG(GLOREF)
I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3)
BLDQ Q $G(RESULT)
;
SENDMSG(GLOREF) ; Transmit the HL7 message
N HLA,HLRST
M HLA("HLS")=@GLOREF
I $D(HLA("HLS")) D
. D GENERATE^HLMA("DGRU-PATIENT-A08-SERVER","LM",1,.HLRST,"")
K HLA,HERR
Q (HLRST)
;
ERRBUL(EVNTINFO,RESULT) ; Generate bulletin if an error occurred while building the HL7 message.
;
N XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
;
S XMCHAN=1
S XMSUB="RAI/MDS HL7 BUILD ERROR"
S (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
;
S XMB="DGRU RAI ERROR"
S XMB(1)=$$GET1^DIQ(2,@EVNTINFO@("DFN"),.01)
S XMB(2)=@EVNTINFO@("EVENT")
S XMB(3)=">>> "_$P(RESULT,"^",2)
S XMB(4)=@EVNTINFO@("USER")
S XMB(5)=$$FMTE^XLFDT(@EVNTINFO@("DATE"))
S XMDT=DT
D ^XMB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGBJ 3462 printed Sep 23, 2025@20:34:12 Page 2
DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 11/7/07 3:49pm
+1 ;;5.3;Registration;**190,312,357,762**;Aug 13, 1993;Build 3
+2 ;
EN ; Main Entry point for patient demographic update to COTS system
+1 ;
+2 LOCK +^XTMP("ADT/HL7 MDS COTS UPDATE"):3
IF '$TEST
QUIT
+3 ;
+4 ; Check for HL7 send parameter
+5 if '$PIECE($$SEND^VAFHUTL(),"^",2)
QUIT
+6 ;
+7 ; Look for patient demographic changes monitored by the COTS system
+8 NEW PVTPTR,DGNODE,DFN,DGDATE,DGARRAY,DGUSR,DGRSLT
+9 ;
+10 SET DGARRAY="^TMP(""DGRAI"",""EVNTINFO"","_$JOB_")"
+11 KILL @DGARRAY
+12 ;
+13 ; Begin looking for entries needing transmission with a type of "COTS UPDATE", Code 6.
+14 SET PVTPTR=0
+15 FOR
SET PVTPTR=+$ORDER(^VAT(391.71,"AXMIT",6,PVTPTR))
if ('PVTPTR)
QUIT
Begin DoDot:1
+16 ; If no entry for xref (out of sync) delete the xref and quit
+17 IF ('$DATA(^VAT(391.71,PVTPTR)))
KILL ^VAT(391.71,"AXMIT",6,PVTPTR)
QUIT
+18 ; Get event date and pointer to patient for entry
+19 SET DGNODE=$GET(^VAT(391.71,PVTPTR,0))
+20 SET DFN=+$PIECE(DGNODE,"^",3)
+21 SET EVNTDT=+DGNODE
+22 ; Check for patient, if not valid, then mark as transmitted and quit
+23 IF ('$DATA(^DPT(DFN,0)))
DO XMITFLAG^VAFCDD01(PVTPTR,"",1)
QUIT
+24 ; p-762
NEW VAIN
DO INP^VADPT
+25 ; P-762
IF '$$CHKWARD^DGRUUTL(+VAIN(4))
DO XMITFLAG^VAFCDD01(PVTPTR,"",1)
KILL VAIN
QUIT
+26 KILL @DGARRAY
+27 SET @DGARRAY@("PIVOT")=PVTPTR
+28 SET @DGARRAY@("REASON",1)=""
+29 IF (+$GET(^DPT(DFN,.35)))
SET @DGARRAY@("REASON",1)=99
+30 ;
+31 SET @DGARRAY@("USER")=$$GET1^DIQ(200,+$PIECE(DGNODE,"^",9),.01)
+32 ;
+33 SET @DGARRAY@("EVENT-NUM")=$PIECE(DGNODE,"^",2)
+34 SET @DGARRAY@("VAR-PTR")=$PIECE(DGNODE,"^",5)
+35 ;
+36 SET DGRSLT=$$BLDA08(DFN,EVNTDT,DGARRAY)
+37 ;deleted Q p-357
IF (DGRSLT<0)
DO ERRBUL(DGARRAY,DGRSLT)
+38 ;
+39 ; Mark entry in pivot file as transmitted
+40 DO XMITFLAG^VAFCDD01(PVTPTR,"",1)
End DoDot:1
+41 ;
+42 LOCK -^XTMP("ADT/HL7 MDS COTS UPDATE")
+43 QUIT
+44 ;
BLDA08(DFN,EVNTDT,EVNTINFO,DGDC,DGOSSN) ;
+1 ;
+2 NEW RESULT,DGTMP,GLOREF
+3 ;
+4 SET DFN=+$GET(DFN)
+5 IF ('$DATA(^DPT(DFN,0)))
SET RESULT="-1^Could not find entry in PATIENT file"
GOTO BLDQ
+6 ;
+7 SET DGDC=$GET(DGDC)
+8 SET DGOSSN=$GET(DGOSSN)
+9 SET EVNTDT=$GET(EVNTDT)
+10 if ('EVNTDT)
SET EVNTDT=$$NOW^XLFDT
+11 ;
+12 SET GLOREF="^TMP(""HLS"","_$JOB_")"
+13 KILL @GLOREF
+14 ;
+15 SET @EVNTINFO@("DFN")=DFN
+16 SET @EVNTINFO@("EVENT")="A08"
+17 SET @EVNTINFO@("DATE")=EVNTDT
+18 ;
+19 NEW HLEID,HL,HLFS,HLECH,HLQ,NDX
+20 ;
+21 KILL HL
+22 DO INIT^HLFNC2("DGRU-PATIENT-A08-SERVER",.HL)
+23 ;
+24 IF ($ORDER(HL(""))']"")
SET RESULT="-1^Server Protocol not found"
GOTO BLDQ
+25 ;
+26 ; Build segment array
+27 DO EN^DGRUGA08(DFN,"","DGTMP",DGDC,DGOSSN)
+28 IF '$ORDER(DGTMP(0))
SET RESULT="-1^Unable to build segment list to transmit"
GOTO BLDQ
+29 ;Check segment list for errors
+30 SET NDX=0
+31 FOR
SET NDX=$ORDER(DGTMP(NDX))
if 'NDX
QUIT
Begin DoDot:1
+32 IF +DGTMP(NDX)<0
SET RESULT="-1^An error occurred in one of the segments"
End DoDot:1
if (+$GET(RESULT)<0)
GOTO BLDQ
+33 ;
+34 MERGE @GLOREF=DGTMP
+35 SET RESULT=$$SENDMSG(GLOREF)
+36 IF +$PIECE(RESULT,"^",2)>0
SET RESULT="-1^"_$PIECE(RESULT,"^",2,3)
BLDQ QUIT $GET(RESULT)
+1 ;
SENDMSG(GLOREF) ; Transmit the HL7 message
+1 NEW HLA,HLRST
+2 MERGE HLA("HLS")=@GLOREF
+3 IF $DATA(HLA("HLS"))
Begin DoDot:1
+4 DO GENERATE^HLMA("DGRU-PATIENT-A08-SERVER","LM",1,.HLRST,"")
End DoDot:1
+5 KILL HLA,HERR
+6 QUIT (HLRST)
+7 ;
ERRBUL(EVNTINFO,RESULT) ; Generate bulletin if an error occurred while building the HL7 message.
+1 ;
+2 NEW XMY,XMDUZ,XMDT,XMZ,XMB,XMCHAN,XMSUB
+3 ;
+4 SET XMCHAN=1
+5 SET XMSUB="RAI/MDS HL7 BUILD ERROR"
+6 SET (XMDUZ,XMDUZ)="RAI/MDS APPLICATION"
+7 ;
+8 SET XMB="DGRU RAI ERROR"
+9 SET XMB(1)=$$GET1^DIQ(2,@EVNTINFO@("DFN"),.01)
+10 SET XMB(2)=@EVNTINFO@("EVENT")
+11 SET XMB(3)=">>> "_$PIECE(RESULT,"^",2)
+12 SET XMB(4)=@EVNTINFO@("USER")
+13 SET XMB(5)=$$FMTE^XLFDT(@EVNTINFO@("DATE"))
+14 SET XMDT=DT
+15 DO ^XMB
+16 QUIT
