Routine: DGRUGBJ

DGRUGBJ ; ALB/SCK - RAI/MDS COTS ADT Background job ; 11/7/07 3:49pm

 ;;5.3;PIMS;**190,312,357,1015,1016**;JUN 30, 2012;Build 20

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")

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

DGRUGBJ   ; ALB/SCK - RAI/MDS COTS ADT Background job ; 11/7/07 3:49pm

 +1       ;;5.3;PIMS;**190,312,357,1015,1016**;JUN 30, 2012;Build 20

 +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

DGRUGBJ.m