VAFCMSG ;ALB/JRP-BACKGROUND JOB TO TRANSMIT ENTRIES IN PIVOT FILE ;7 Dec 2018 3:39 PM
;;5.3;Registration;**91,149,530,578,974**;Jun 06, 1996;Build 2
;
MAIN ;Main entry point for background job
;
;attempt to lock non existant global.
L +^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7"):1 I '$T Q
;Send messages ? 0=STOP,2=SUSPEND
N SEND
S SEND=$P($$SEND^VAFHUTL(),"^",2)
I (SEND=0)!(SEND=2) L -^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7") Q
;Send Registration messages
D BCSTA04
;Send changes to patient's demographical data (ADT-A08)
D BCSTA08
;Send changes to patient's treating facility list (MFU-M05)
D BCKTFMFU^VAFCTFMF
;unlock global
L -^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7")
;K DIC,X,Y
Q
;
BCSTA08 ;Broadcast ADT-A08 messages for all entries in ADT/HL PIVOT file
;(#391.71) that have been marked for transmission
;
;Input : None
;Output : None
;
;Declare variables
N PIVOTPTR,NODE,DFN,EDITDATE,TMP,INFOARR
S INFOARR="^TMP(""VAFCMSG"","_$J_",""EVNTINFO"")"
K @INFOARR
;Loop through pivot file based on demographic updates
S PIVOTPTR=0
F S PIVOTPTR=+$O(^VAT(391.71,"AXMIT",4,PIVOTPTR)) Q:('PIVOTPTR) D
.;Bad entry in cross reference - delete it and quit
.I ('$D(^VAT(391.71,PIVOTPTR))) K ^VAT(391.71,"AXMIT",4,PIVOTPTR) Q
.;Get event date and pointer to patient
.S NODE=$G(^VAT(391.71,PIVOTPTR,0))
.S EDITDATE=+NODE
.S DFN=+$P(NODE,"^",3)
.;PATCH 530 check global for lock status - quit if locked.
.L +^DPT(DFN):1 I '$T Q
.;Bad pointer to patient - mark entry as transmitted and quit
.I ('$D(^DPT(DFN,0)))!($G(^DPT(DFN,-9))) D XMITFLAG^VAFCDD01(PIVOTPTR,"",1) Q
.I $P(^DPT(DFN,0),U)="" D XMITFLAG^VAFCDD01(PIVOTPTR,"",1) Q
.;**974,Story 841921 (mko): If name components were edited, a bug
.; in UPDNAME^XLFNAME could allow the .01 to be more than 30 characters.
.I '$D(^DPT("B",$E($P(^DPT(DFN,0),U),1,30),DFN)) D XMITFLAG^VAFCDD01(PIVOTPTR,"",1) Q
.;Store info into event information array
.K @INFOARR
.S @INFOARR@("PIVOT")=PIVOTPTR
.;Event reason code
.; 99 = Death 98 = Resurrection 97=Sensitivity Update
.; Death will overwrite any other reason code. It is the
.; dominant reason code.
.S @INFOARR@("REASON",1)=""
.S @INFOARR@("REASON",1)=$P($G(^VAT(391.71,PIVOTPTR,0)),"^",10)
.I (+$G(^DPT(DFN,.35))) S @INFOARR@("REASON",1)=99
.;
.; user/operator name from duz
.S DIC="^VA(200,",DIC(0)="MZO",X="`"_+$P(NODE,"^",9) D ^DIC
.S @INFOARR@("USER")=$P($G(Y),"^",2)
.;
.S @INFOARR@("EVENT-NUM")=$P(NODE,"^",2)
.S @INFOARR@("VAR-PTR")=$P(NODE,"^",5)
.;
.;Broadcast ADT-A08 message
.S TMP=$$BCSTADT^VAFCMSG0(DFN,"A08",EDITDATE,INFOARR)
.;Store result in pivot file
.S:$P(TMP,U,2)]"" TMP=$P(TMP,U,2) D FILERM^VAFCUTL(PIVOTPTR,TMP)
.;Error broadcasting message
.Q:(TMP<0)
.;Mark entry in pivot file as transmitted
.D XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
.;PATCH 530 if locked by check unlock.
.L -^DPT(DFN)
;Done - clean up and quit
K @INFOARR
Q
;
BCSTA04 ;Broadcast ADT-A04 messages for all entries in ADT/HL PIVOT file
;(#391.71) that have been marked for transmission
;
;Input : None
;Output : None
;
;Declare variables
N PIVOTPTR,NODE,DFN,EDITDATE,FIELDS,RESULT
S PIVOTPTR=0
F S PIVOTPTR=+$O(^VAT(391.71,"AXMIT",3,PIVOTPTR)) Q:('PIVOTPTR) D
.;Bad entry in cross reference - delete it and quit
.I ('$D(^VAT(391.71,PIVOTPTR))) K ^VAT(391.71,"AXMIT",3,PIVOTPTR) Q
.;Get event date and pointer to patient
.S NODE=$G(^VAT(391.71,PIVOTPTR,0))
.S FIELDS=$G(^VAT(391.71,PIVOTPTR,2))
.S USER=+$P(NODE,"^",9)
.S EDITDATE=+NODE
.S DFN=+$P(NODE,"^",3)
.;PATCH 530 check for locked record - quit if locked.
.L +^DPT(DFN):1 I '$T Q
.;Bad pointer to patient - mark entry as transmitted and quit
.I ('$D(^DPT(DFN,0)))!($G(^DPT(DFN,-9))) D XMITFLAG^VAFCDD01(PIVOTPTR,"",1) Q
.I $P(^DPT(DFN,0),U)="" D XMITFLAG^VAFCDD01(PIVOTPTR,"",1) Q
.;**974,Story 841921 (mko): If name components were edited, a bug
.; in UPDNAME^XLFNAME could allow the .01 to be more than 30 characters.
.I '$D(^DPT("B",$E($P(^DPT(DFN,0),U),1,30),DFN)) D XMITFLAG^VAFCDD01(PIVOTPTR,"",1) Q
.;Broadcast ADT-A04 message
.S RESULT=$$EN^VAFCA04(DFN,EDITDATE,USER,PIVOTPTR)
.D XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
.L -^DPT(DFN)
;Done - quit
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCMSG 4315 printed Nov 22, 2024@18:11:58 Page 2
VAFCMSG ;ALB/JRP-BACKGROUND JOB TO TRANSMIT ENTRIES IN PIVOT FILE ;7 Dec 2018 3:39 PM
+1 ;;5.3;Registration;**91,149,530,578,974**;Jun 06, 1996;Build 2
+2 ;
MAIN ;Main entry point for background job
+1 ;
+2 ;attempt to lock non existant global.
+3 LOCK +^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7"):1
IF '$TEST
QUIT
+4 ;Send messages ? 0=STOP,2=SUSPEND
+5 NEW SEND
+6 SET SEND=$PIECE($$SEND^VAFHUTL(),"^",2)
+7 IF (SEND=0)!(SEND=2)
LOCK -^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7")
QUIT
+8 ;Send Registration messages
+9 DO BCSTA04
+10 ;Send changes to patient's demographical data (ADT-A08)
+11 DO BCSTA08
+12 ;Send changes to patient's treating facility list (MFU-M05)
+13 DO BCKTFMFU^VAFCTFMF
+14 ;unlock global
+15 LOCK -^VAT(391.71,"VAFC BATCH UPDATE ADT/HL7")
+16 ;K DIC,X,Y
+17 QUIT
+18 ;
BCSTA08 ;Broadcast ADT-A08 messages for all entries in ADT/HL PIVOT file
+1 ;(#391.71) that have been marked for transmission
+2 ;
+3 ;Input : None
+4 ;Output : None
+5 ;
+6 ;Declare variables
+7 NEW PIVOTPTR,NODE,DFN,EDITDATE,TMP,INFOARR
+8 SET INFOARR="^TMP(""VAFCMSG"","_$JOB_",""EVNTINFO"")"
+9 KILL @INFOARR
+10 ;Loop through pivot file based on demographic updates
+11 SET PIVOTPTR=0
+12 FOR
SET PIVOTPTR=+$ORDER(^VAT(391.71,"AXMIT",4,PIVOTPTR))
if ('PIVOTPTR)
QUIT
Begin DoDot:1
+13 ;Bad entry in cross reference - delete it and quit
+14 IF ('$DATA(^VAT(391.71,PIVOTPTR)))
KILL ^VAT(391.71,"AXMIT",4,PIVOTPTR)
QUIT
+15 ;Get event date and pointer to patient
+16 SET NODE=$GET(^VAT(391.71,PIVOTPTR,0))
+17 SET EDITDATE=+NODE
+18 SET DFN=+$PIECE(NODE,"^",3)
+19 ;PATCH 530 check global for lock status - quit if locked.
+20 LOCK +^DPT(DFN):1
IF '$TEST
QUIT
+21 ;Bad pointer to patient - mark entry as transmitted and quit
+22 IF ('$DATA(^DPT(DFN,0)))!($GET(^DPT(DFN,-9)))
DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
QUIT
+23 IF $PIECE(^DPT(DFN,0),U)=""
DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
QUIT
+24 ;**974,Story 841921 (mko): If name components were edited, a bug
+25 ; in UPDNAME^XLFNAME could allow the .01 to be more than 30 characters.
+26 IF '$DATA(^DPT("B",$EXTRACT($PIECE(^DPT(DFN,0),U),1,30),DFN))
DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
QUIT
+27 ;Store info into event information array
+28 KILL @INFOARR
+29 SET @INFOARR@("PIVOT")=PIVOTPTR
+30 ;Event reason code
+31 ; 99 = Death 98 = Resurrection 97=Sensitivity Update
+32 ; Death will overwrite any other reason code. It is the
+33 ; dominant reason code.
+34 SET @INFOARR@("REASON",1)=""
+35 SET @INFOARR@("REASON",1)=$PIECE($GET(^VAT(391.71,PIVOTPTR,0)),"^",10)
+36 IF (+$GET(^DPT(DFN,.35)))
SET @INFOARR@("REASON",1)=99
+37 ;
+38 ; user/operator name from duz
+39 SET DIC="^VA(200,"
SET DIC(0)="MZO"
SET X="`"_+$PIECE(NODE,"^",9)
DO ^DIC
+40 SET @INFOARR@("USER")=$PIECE($GET(Y),"^",2)
+41 ;
+42 SET @INFOARR@("EVENT-NUM")=$PIECE(NODE,"^",2)
+43 SET @INFOARR@("VAR-PTR")=$PIECE(NODE,"^",5)
+44 ;
+45 ;Broadcast ADT-A08 message
+46 SET TMP=$$BCSTADT^VAFCMSG0(DFN,"A08",EDITDATE,INFOARR)
+47 ;Store result in pivot file
+48 if $PIECE(TMP,U,2)]""
SET TMP=$PIECE(TMP,U,2)
DO FILERM^VAFCUTL(PIVOTPTR,TMP)
+49 ;Error broadcasting message
+50 if (TMP<0)
QUIT
+51 ;Mark entry in pivot file as transmitted
+52 DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
+53 ;PATCH 530 if locked by check unlock.
+54 LOCK -^DPT(DFN)
End DoDot:1
+55 ;Done - clean up and quit
+56 KILL @INFOARR
+57 QUIT
+58 ;
BCSTA04 ;Broadcast ADT-A04 messages for all entries in ADT/HL PIVOT file
+1 ;(#391.71) that have been marked for transmission
+2 ;
+3 ;Input : None
+4 ;Output : None
+5 ;
+6 ;Declare variables
+7 NEW PIVOTPTR,NODE,DFN,EDITDATE,FIELDS,RESULT
+8 SET PIVOTPTR=0
+9 FOR
SET PIVOTPTR=+$ORDER(^VAT(391.71,"AXMIT",3,PIVOTPTR))
if ('PIVOTPTR)
QUIT
Begin DoDot:1
+10 ;Bad entry in cross reference - delete it and quit
+11 IF ('$DATA(^VAT(391.71,PIVOTPTR)))
KILL ^VAT(391.71,"AXMIT",3,PIVOTPTR)
QUIT
+12 ;Get event date and pointer to patient
+13 SET NODE=$GET(^VAT(391.71,PIVOTPTR,0))
+14 SET FIELDS=$GET(^VAT(391.71,PIVOTPTR,2))
+15 SET USER=+$PIECE(NODE,"^",9)
+16 SET EDITDATE=+NODE
+17 SET DFN=+$PIECE(NODE,"^",3)
+18 ;PATCH 530 check for locked record - quit if locked.
+19 LOCK +^DPT(DFN):1
IF '$TEST
QUIT
+20 ;Bad pointer to patient - mark entry as transmitted and quit
+21 IF ('$DATA(^DPT(DFN,0)))!($GET(^DPT(DFN,-9)))
DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
QUIT
+22 IF $PIECE(^DPT(DFN,0),U)=""
DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
QUIT
+23 ;**974,Story 841921 (mko): If name components were edited, a bug
+24 ; in UPDNAME^XLFNAME could allow the .01 to be more than 30 characters.
+25 IF '$DATA(^DPT("B",$EXTRACT($PIECE(^DPT(DFN,0),U),1,30),DFN))
DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
QUIT
+26 ;Broadcast ADT-A04 message
+27 SET RESULT=$$EN^VAFCA04(DFN,EDITDATE,USER,PIVOTPTR)
+28 DO XMITFLAG^VAFCDD01(PIVOTPTR,"",1)
+29 LOCK -^DPT(DFN)
End DoDot:1
+30 ;Done - quit
+31 QUIT
