Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHDD

VAFHDD.m

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