DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 8-10-99
 ;;5.3;Registration;**190,312,357**;Aug 13, 1993
 ;
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
 . ;
 . 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 bulliten 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