- 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 Mar 13, 2025@22:07:33 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