source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHDD.m@ 1326

Last change on this file since 1326 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1VAFHDD ;ALB/JLU;receives DD changes
2 ;;5.3;Registration;**91**;Jun 06, 1996
3 ;
4EN(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
29EX D EXIT
30 Q
31 ;
32 ;
33A34 ;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 ;
42TA34 ;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,,)
69ET34 D EXIT
70 Q
71 ;
72EXIT ;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 ;
88UA08 ;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 ;
99MA08 ;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
Note: See TracBrowser for help on using the repository browser.