| [613] | 1 | VAFHDD ;ALB/JLU;receives DD changes
|
|---|
| 2 | ;;5.3;Registration;**91**;Jun 06, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | EN(VAFHA,VAFHDFN,VAFHBEF) ;
|
|---|
| 5 | ;this is the main entry point to process any changes to a patient's
|
|---|
| 6 | ;record through the patient file DD. This routine now only handles
|
|---|
| 7 | ;merges from the cross-ref on dd(2,.363, primary long id.
|
|---|
| 8 | ;
|
|---|
| 9 | ;Input
|
|---|
| 10 | ;VAFHA - contains a 'M'. This tells the software that the change
|
|---|
| 11 | ; is a result of a Merge. Only a change to the Primary
|
|---|
| 12 | ; Long ID can cause a Merge message to be fired.
|
|---|
| 13 | ;
|
|---|
| 14 | ;VAFHDFN - The DFN of the current patient.
|
|---|
| 15 | ;VAFHBEF - is only to be defined in a merge message case it will
|
|---|
| 16 | ; contain the before value of Primary Long ID.
|
|---|
| 17 | ;
|
|---|
| 18 | ;Outputs
|
|---|
| 19 | ;there are no output variables
|
|---|
| 20 | ;
|
|---|
| 21 | I VAFHA="A" Q
|
|---|
| 22 | I '$$SEND^VAFHUTL() G EX
|
|---|
| 23 | I VAFHA="M" D
|
|---|
| 24 | . ;B
|
|---|
| 25 | . N PRIMELIG
|
|---|
| 26 | . I $G(VAFHDFN) S PRIMELIG=$P($G(^DPT(VAFHDFN,.36)),"^",3)
|
|---|
| 27 | . I PRIMELIG'=$G(VAFHBEF) D A34 ;merge needs to be generated
|
|---|
| 28 | I VAFHA="U" D UA08 ;update message to be generated
|
|---|
| 29 | EX D EXIT
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | ;
|
|---|
| 33 | A34 ;this line tag will start a job that will build an A34 and A08 message.
|
|---|
| 34 | ;
|
|---|
| 35 | S ZTRTN="TA34^VAFHDD",ZTDESC="Generating A34 MERGE message"
|
|---|
| 36 | S ZTDTH=$H,ZTIO="",(ZTSAVE("VAFHBEF"),ZTSAVE("VAFHDFN"))=""
|
|---|
| 37 | D ^%ZTLOAD
|
|---|
| 38 | K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ;
|
|---|
| 42 | TA34 ;This line tag is the job that will generate the message to send
|
|---|
| 43 | ;an A34.
|
|---|
| 44 | ;
|
|---|
| 45 | S VAFHPID="1,2,4,6,7,8,11,12,13,14,16,19"
|
|---|
| 46 | S VAFHZPD="2,3,4,5,6,7,8,9,10,11,12,13,14,15"
|
|---|
| 47 | K HLERR
|
|---|
| 48 | S VAFHGBL="^TMP(""HLS"","_$J_")"
|
|---|
| 49 | K ^TMP("HLS",$J)
|
|---|
| 50 | K HL D INIT^HLFNC2("VAFH A34",.HL)
|
|---|
| 51 | I $D(HL)=1 DO G ET34
|
|---|
| 52 | . S HLERR="-1^Unable to generate an A34 for "_VAFHDFN_" error in "_$P(HL,"^",2)
|
|---|
| 53 | ;
|
|---|
| 54 | S HLMTN="ADT"_$E(HL("ECH"))_"A34"
|
|---|
| 55 | S CTR=1
|
|---|
| 56 | ;;the next two lines were for a batch message that may need to be sent
|
|---|
| 57 | ;;if a followup A08 is needed as a result of a merge message. It was
|
|---|
| 58 | ;;determined late that this is not needed yet.
|
|---|
| 59 | ;;S @VAFHGBL@(CTR)=$$BHS^HLFNC1(HLMTN) ;builds the batch header
|
|---|
| 60 | ;;S CTR=CTR+1
|
|---|
| 61 | S VAFHVAR=$$EN^VAFHLA34(VAFHDFN,VAFHGBL,CTR,HLMTN,VAFHBEF,"05",VAFHPID,VAFHZPD) ;this call creates the A34 message
|
|---|
| 62 | I 'VAFHVAR S HLERR="-1^Unable to generate an A34 for "_VAFHDFN_" "_$P(VAFHVAR,U,2) G ET34
|
|---|
| 63 | S CTR=$P(VAFHVAR,U,2)
|
|---|
| 64 | S CTR=CTR+1
|
|---|
| 65 | ;;D MA08 ;creates the A08 follow message
|
|---|
| 66 | S HLEVN=1
|
|---|
| 67 | S HLSDT="VAFHMRG" ;this set is necessary do not remove.
|
|---|
| 68 | D GENERATE^HLMA("VAFH A34","GM",1,.HLRST,,)
|
|---|
| 69 | ET34 D EXIT
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | EXIT ;cleans up the variables
|
|---|
| 73 | I $D(HLERR)!($D(HL)=1) DO
|
|---|
| 74 | .N ERR
|
|---|
| 75 | .S ERR="ERR"
|
|---|
| 76 | .S @ERR@(1)=$G(HLERR)
|
|---|
| 77 | .S @ERR@(2)=$G(HL)
|
|---|
| 78 | .S @ERR@(3)=$G(HLRST)
|
|---|
| 79 | .S:'$D(VAFHDT) VAFHDT=DT
|
|---|
| 80 | .S:'$D(VAFHPIV) VAFHPIV=""
|
|---|
| 81 | .D EBULL^VAFHUTL2(VAFHDFN,VAFHDT,+VAFHPIV,ERR) ;if an error call the bulletin routine to send an error bulletin.
|
|---|
| 82 | .Q
|
|---|
| 83 | D KILL^HLTRANS
|
|---|
| 84 | K VAFHVAR,^TMP("HLS",$J),VAFHPV1F,VAFHDG1F,VAFHPID,VAFHZPD,VAFHGBL,VAFHVAR,CTR,ERR,VAFHDT,VAFHPIV,VAFHPTR,VAFHPIV1,VAFHLTD,VAFHTYPE,VAFHA08
|
|---|
| 85 | K HLEVN,HLSDT,HLEVN,HLMTN,HLNDAP
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | UA08 ;This will build the A08 message for an update event.
|
|---|
| 89 | ;
|
|---|
| 90 | S VAFHPTR=VAFHDFN_";DPT("
|
|---|
| 91 | S VAFHDT=$P(DT,".")
|
|---|
| 92 | S VAFHPIV=$$PIVNW^VAFHPIVT(VAFHDFN,VAFHDT,4,VAFHPTR) ;since no entry make a new one
|
|---|
| 93 | I +VAFHPIV<0 S HLERR="-1^Could not create update entry in Pivot file."
|
|---|
| 94 | Q:$D(HLERR)
|
|---|
| 95 | S VAFHPIV1=$$SETTRAN^VAFHPIV2(+VAFHPIV) ;set the transmit field in the pivot entry
|
|---|
| 96 | I +VAFHPIV1<0 S HLERR="-1^Could not set the Transmit field for Pivot entry "_VAFHPIV
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | MA08 ;creates an A08 message for a merge event
|
|---|
| 100 | S VAFHLTD=$$LTD^VAFHUTL(VAFHDFN) ;get the last activity for the veteran
|
|---|
| 101 | I VAFHLTD<0 DO ;if no activity send an update a08 with like UA08
|
|---|
| 102 | .S VAFHTYPE=4
|
|---|
| 103 | .S VAFHPTR=VAFHDFN_";DPT("
|
|---|
| 104 | .S VAFHDT=$P(DT,".")
|
|---|
| 105 | .Q
|
|---|
| 106 | I VAFHLTD>0 DO ;if activity send that pivot number and A08 type
|
|---|
| 107 | .S VAFHTYPE=$S($P(VAFHLTD,U,2)="R":3,"ID"[$P(VAFHLTD,U,2):1,"AS"[$P(VAFHLTD,U,2):2,1:4)
|
|---|
| 108 | .S VAFHPTR=$P(VAFHLTD,U,4)
|
|---|
| 109 | .S VAFHDT=$P(VAFHLTD,U)
|
|---|
| 110 | .Q
|
|---|
| 111 | S VAFHPIV=$$PIVNW^VAFHPIVT(VAFHDFN,VAFHDT,VAFHTYPE,VAFHPTR) ;creates a new Pivot entry
|
|---|
| 112 | I VAFHPIV<0 S HLERR=VAFHPIV Q
|
|---|
| 113 | S VAFHPV1F=$S(34[VAFHTYPE:50,1:"A")
|
|---|
| 114 | S VAFHDG1F=$S(34[VAFHTYPE:"",1:"A")
|
|---|
| 115 | I VAFHTYPE=1 ; DO RICH'S
|
|---|
| 116 | I VAFHTYPE>1 DO
|
|---|
| 117 | .S VAFHPV1F=$S(34[VAFHTYPE:50,1:"A")
|
|---|
| 118 | .S VAFHDG1F=$S(34[VAFHTYPE:"",1:"A")
|
|---|
| 119 | .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
|
|---|
| 120 | .I VAFHA08<0 S HLERR=VAFHA08
|
|---|
| 121 | Q
|
|---|
