VAFHDD ;ALB/JLU;receives DD changes
;;5.3;Registration;**91**;Jun 06, 1996
;
EN(VAFHA,VAFHDFN,VAFHBEF) ;
;this is the main entry point to process any changes to a patient's
;record through the patient file DD. This routine now only handles
;merges from the cross-ref on dd(2,.363, primary long id.
;
;Input
;VAFHA - contains a 'M'. This tells the software that the change
; is a result of a Merge. Only a change to the Primary
; Long ID can cause a Merge message to be fired.
;
;VAFHDFN - The DFN of the current patient.
;VAFHBEF - is only to be defined in a merge message case it will
; contain the before value of Primary Long ID.
;
;Outputs
;there are no output variables
;
I VAFHA="A" Q
I '$$SEND^VAFHUTL() G EX
I VAFHA="M" D
. ;B
. N PRIMELIG
. I $G(VAFHDFN) S PRIMELIG=$P($G(^DPT(VAFHDFN,.36)),"^",3)
. I PRIMELIG'=$G(VAFHBEF) D A34 ;merge needs to be generated
I VAFHA="U" D UA08 ;update message to be generated
EX D EXIT
Q
;
;
A34 ;this line tag will start a job that will build an A34 and A08 message.
;
S ZTRTN="TA34^VAFHDD",ZTDESC="Generating A34 MERGE message"
S ZTDTH=$H,ZTIO="",(ZTSAVE("VAFHBEF"),ZTSAVE("VAFHDFN"))=""
D ^%ZTLOAD
K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
Q
;
;
TA34 ;This line tag is the job that will generate the message to send
;an A34.
;
S VAFHPID="1,2,4,6,7,8,11,12,13,14,16,19"
S VAFHZPD="2,3,4,5,6,7,8,9,10,11,12,13,14,15"
K HLERR
S VAFHGBL="^TMP(""HLS"","_$J_")"
K ^TMP("HLS",$J)
K HL D INIT^HLFNC2("VAFH A34",.HL)
I $D(HL)=1 DO G ET34
. S HLERR="-1^Unable to generate an A34 for "_VAFHDFN_" error in "_$P(HL,"^",2)
;
S HLMTN="ADT"_$E(HL("ECH"))_"A34"
S CTR=1
;;the next two lines were for a batch message that may need to be sent
;;if a followup A08 is needed as a result of a merge message. It was
;;determined late that this is not needed yet.
;;S @VAFHGBL@(CTR)=$$BHS^HLFNC1(HLMTN) ;builds the batch header
;;S CTR=CTR+1
S VAFHVAR=$$EN^VAFHLA34(VAFHDFN,VAFHGBL,CTR,HLMTN,VAFHBEF,"05",VAFHPID,VAFHZPD) ;this call creates the A34 message
I 'VAFHVAR S HLERR="-1^Unable to generate an A34 for "_VAFHDFN_" "_$P(VAFHVAR,U,2) G ET34
S CTR=$P(VAFHVAR,U,2)
S CTR=CTR+1
;;D MA08 ;creates the A08 follow message
S HLEVN=1
S HLSDT="VAFHMRG" ;this set is necessary do not remove.
D GENERATE^HLMA("VAFH A34","GM",1,.HLRST,,)
ET34 D EXIT
Q
;
EXIT ;cleans up the variables
I $D(HLERR)!($D(HL)=1) DO
.N ERR
.S ERR="ERR"
.S @ERR@(1)=$G(HLERR)
.S @ERR@(2)=$G(HL)
.S @ERR@(3)=$G(HLRST)
.S:'$D(VAFHDT) VAFHDT=DT
.S:'$D(VAFHPIV) VAFHPIV=""
.D EBULL^VAFHUTL2(VAFHDFN,VAFHDT,+VAFHPIV,ERR) ;if an error call the bulletin routine to send an error bulletin.
.Q
D KILL^HLTRANS
K VAFHVAR,^TMP("HLS",$J),VAFHPV1F,VAFHDG1F,VAFHPID,VAFHZPD,VAFHGBL,VAFHVAR,CTR,ERR,VAFHDT,VAFHPIV,VAFHPTR,VAFHPIV1,VAFHLTD,VAFHTYPE,VAFHA08
K HLEVN,HLSDT,HLEVN,HLMTN,HLNDAP
Q
;
UA08 ;This will build the A08 message for an update event.
;
S VAFHPTR=VAFHDFN_";DPT("
S VAFHDT=$P(DT,".")
S VAFHPIV=$$PIVNW^VAFHPIVT(VAFHDFN,VAFHDT,4,VAFHPTR) ;since no entry make a new one
I +VAFHPIV<0 S HLERR="-1^Could not create update entry in Pivot file."
Q:$D(HLERR)
S VAFHPIV1=$$SETTRAN^VAFHPIV2(+VAFHPIV) ;set the transmit field in the pivot entry
I +VAFHPIV1<0 S HLERR="-1^Could not set the Transmit field for Pivot entry "_VAFHPIV
Q
;
MA08 ;creates an A08 message for a merge event
S VAFHLTD=$$LTD^VAFHUTL(VAFHDFN) ;get the last activity for the veteran
I VAFHLTD<0 DO ;if no activity send an update a08 with like UA08
.S VAFHTYPE=4
.S VAFHPTR=VAFHDFN_";DPT("
.S VAFHDT=$P(DT,".")
.Q
I VAFHLTD>0 DO ;if activity send that pivot number and A08 type
.S VAFHTYPE=$S($P(VAFHLTD,U,2)="R":3,"ID"[$P(VAFHLTD,U,2):1,"AS"[$P(VAFHLTD,U,2):2,1:4)
.S VAFHPTR=$P(VAFHLTD,U,4)
.S VAFHDT=$P(VAFHLTD,U)
.Q
S VAFHPIV=$$PIVNW^VAFHPIVT(VAFHDFN,VAFHDT,VAFHTYPE,VAFHPTR) ;creates a new Pivot entry
I VAFHPIV<0 S HLERR=VAFHPIV Q
S VAFHPV1F=$S(34[VAFHTYPE:50,1:"A")
S VAFHDG1F=$S(34[VAFHTYPE:"",1:"A")
I VAFHTYPE=1 ; DO RICH'S
I VAFHTYPE>1 DO
.S VAFHPV1F=$S(34[VAFHTYPE:50,1:"A")
.S VAFHDG1F=$S(34[VAFHTYPE:"",1:"A")
.S VAFHA08=$$UP^VAFHCA08(VAFHDFN,+VAFHPIV,$P(VAFHPIV,U,2),CTR,VAFHGBL,VAFHPID,VAFHZPD,VAFHPV1F,VAFHDG1F) ;creates the A08 for the type of event (outpatient) ONLY TO USE VISIT NUMBER FOR REGISTRATIONS
.I VAFHA08<0 S HLERR=VAFHA08
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHDD 4451 printed Nov 22, 2024@18:12:51 Page 2
VAFHDD ;ALB/JLU;receives DD changes
+1 ;;5.3;Registration;**91**;Jun 06, 1996
+2 ;
EN(VAFHA,VAFHDFN,VAFHBEF) ;
+1 ;this is the main entry point to process any changes to a patient's
+2 ;record through the patient file DD. This routine now only handles
+3 ;merges from the cross-ref on dd(2,.363, primary long id.
+4 ;
+5 ;Input
+6 ;VAFHA - contains a 'M'. This tells the software that the change
+7 ; is a result of a Merge. Only a change to the Primary
+8 ; Long ID can cause a Merge message to be fired.
+9 ;
+10 ;VAFHDFN - The DFN of the current patient.
+11 ;VAFHBEF - is only to be defined in a merge message case it will
+12 ; contain the before value of Primary Long ID.
+13 ;
+14 ;Outputs
+15 ;there are no output variables
+16 ;
+17 IF VAFHA="A"
QUIT
+18 IF '$$SEND^VAFHUTL()
GOTO EX
+19 IF VAFHA="M"
Begin DoDot:1
+20 ;B
+21 NEW PRIMELIG
+22 IF $GET(VAFHDFN)
SET PRIMELIG=$PIECE($GET(^DPT(VAFHDFN,.36)),"^",3)
+23 ;merge needs to be generated
IF PRIMELIG'=$GET(VAFHBEF)
DO A34
End DoDot:1
+24 ;update message to be generated
IF VAFHA="U"
DO UA08
EX DO EXIT
+1 QUIT
+2 ;
+3 ;
A34 ;this line tag will start a job that will build an A34 and A08 message.
+1 ;
+2 SET ZTRTN="TA34^VAFHDD"
SET ZTDESC="Generating A34 MERGE message"
+3 SET ZTDTH=$HOROLOG
SET ZTIO=""
SET (ZTSAVE("VAFHBEF"),ZTSAVE("VAFHDFN"))=""
+4 DO ^%ZTLOAD
+5 KILL ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+6 QUIT
+7 ;
+8 ;
TA34 ;This line tag is the job that will generate the message to send
+1 ;an A34.
+2 ;
+3 SET VAFHPID="1,2,4,6,7,8,11,12,13,14,16,19"
+4 SET VAFHZPD="2,3,4,5,6,7,8,9,10,11,12,13,14,15"
+5 KILL HLERR
+6 SET VAFHGBL="^TMP(""HLS"","_$JOB_")"
+7 KILL ^TMP("HLS",$JOB)
+8 KILL HL
DO INIT^HLFNC2("VAFH A34",.HL)
+9 IF $DATA(HL)=1
Begin DoDot:1
+10 SET HLERR="-1^Unable to generate an A34 for "_VAFHDFN_" error in "_$PIECE(HL,"^",2)
End DoDot:1
GOTO ET34
+11 ;
+12 SET HLMTN="ADT"_$EXTRACT(HL("ECH"))_"A34"
+13 SET CTR=1
+14 ;;the next two lines were for a batch message that may need to be sent
+15 ;;if a followup A08 is needed as a result of a merge message. It was
+16 ;;determined late that this is not needed yet.
+17 ;;S @VAFHGBL@(CTR)=$$BHS^HLFNC1(HLMTN) ;builds the batch header
+18 ;;S CTR=CTR+1
+19 ;this call creates the A34 message
SET VAFHVAR=$$EN^VAFHLA34(VAFHDFN,VAFHGBL,CTR,HLMTN,VAFHBEF,"05",VAFHPID,VAFHZPD)
+20 IF 'VAFHVAR
SET HLERR="-1^Unable to generate an A34 for "_VAFHDFN_" "_$PIECE(VAFHVAR,U,2)
GOTO ET34
+21 SET CTR=$PIECE(VAFHVAR,U,2)
+22 SET CTR=CTR+1
+23 ;;D MA08 ;creates the A08 follow message
+24 SET HLEVN=1
+25 ;this set is necessary do not remove.
SET HLSDT="VAFHMRG"
+26 DO GENERATE^HLMA("VAFH A34","GM",1,.HLRST,,)
ET34 DO EXIT
+1 QUIT
+2 ;
EXIT ;cleans up the variables
+1 IF $DATA(HLERR)!($DATA(HL)=1)
Begin DoDot:1
+2 NEW ERR
+3 SET ERR="ERR"
+4 SET @ERR@(1)=$GET(HLERR)
+5 SET @ERR@(2)=$GET(HL)
+6 SET @ERR@(3)=$GET(HLRST)
+7 if '$DATA(VAFHDT)
SET VAFHDT=DT
+8 if '$DATA(VAFHPIV)
SET VAFHPIV=""
+9 ;if an error call the bulletin routine to send an error bulletin.
DO EBULL^VAFHUTL2(VAFHDFN,VAFHDT,+VAFHPIV,ERR)
+10 QUIT
End DoDot:1
+11 DO KILL^HLTRANS
+12 KILL VAFHVAR,^TMP("HLS",$JOB),VAFHPV1F,VAFHDG1F,VAFHPID,VAFHZPD,VAFHGBL,VAFHVAR,CTR,ERR,VAFHDT,VAFHPIV,VAFHPTR,VAFHPIV1,VAFHLTD,VAFHTYPE,VAFHA08
+13 KILL HLEVN,HLSDT,HLEVN,HLMTN,HLNDAP
+14 QUIT
+15 ;
UA08 ;This will build the A08 message for an update event.
+1 ;
+2 SET VAFHPTR=VAFHDFN_";DPT("
+3 SET VAFHDT=$PIECE(DT,".")
+4 ;since no entry make a new one
SET VAFHPIV=$$PIVNW^VAFHPIVT(VAFHDFN,VAFHDT,4,VAFHPTR)
+5 IF +VAFHPIV<0
SET HLERR="-1^Could not create update entry in Pivot file."
+6 if $DATA(HLERR)
QUIT
+7 ;set the transmit field in the pivot entry
SET VAFHPIV1=$$SETTRAN^VAFHPIV2(+VAFHPIV)
+8 IF +VAFHPIV1<0
SET HLERR="-1^Could not set the Transmit field for Pivot entry "_VAFHPIV
+9 QUIT
+10 ;
MA08 ;creates an A08 message for a merge event
+1 ;get the last activity for the veteran
SET VAFHLTD=$$LTD^VAFHUTL(VAFHDFN)
+2 ;if no activity send an update a08 with like UA08
IF VAFHLTD<0
Begin DoDot:1
+3 SET VAFHTYPE=4
+4 SET VAFHPTR=VAFHDFN_";DPT("
+5 SET VAFHDT=$PIECE(DT,".")
+6 QUIT
End DoDot:1
+7 ;if activity send that pivot number and A08 type
IF VAFHLTD>0
Begin DoDot:1
+8 SET VAFHTYPE=$SELECT($PIECE(VAFHLTD,U,2)="R":3,"ID"[$PIECE(VAFHLTD,U,2):1,"AS"[$PIECE(VAFHLTD,U,2):2,1:4)
+9 SET VAFHPTR=$PIECE(VAFHLTD,U,4)
+10 SET VAFHDT=$PIECE(VAFHLTD,U)
+11 QUIT
End DoDot:1
+12 ;creates a new Pivot entry
SET VAFHPIV=$$PIVNW^VAFHPIVT(VAFHDFN,VAFHDT,VAFHTYPE,VAFHPTR)
+13 IF VAFHPIV<0
SET HLERR=VAFHPIV
QUIT
+14 SET VAFHPV1F=$SELECT(34[VAFHTYPE:50,1:"A")
+15 SET VAFHDG1F=$SELECT(34[VAFHTYPE:"",1:"A")
+16 ; DO RICH'S
IF VAFHTYPE=1
+17 IF VAFHTYPE>1
Begin DoDot:1
+18 SET VAFHPV1F=$SELECT(34[VAFHTYPE:50,1:"A")
+19 SET VAFHDG1F=$SELECT(34[VAFHTYPE:"",1:"A")
+20 ;creates the A08 for the type of event (outpatient) ONLY TO USE VISIT NUMBER FOR REGISTRATIONS
SET VAFHA08=$$UP^VAFHCA08(VAFHDFN,+VAFHPIV,$PIECE(VAFHPIV,U,2),CTR,VAFHGBL,VAFHPID,VAFHZPD,VAFHPV1F,VAFHDG1F)
+21 IF VAFHA08<0
SET HLERR=VAFHA08
End DoDot:1
+22 QUIT
