source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCEHU4.m@ 949

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1VAFCEHU4 ;BIR/LTL,PTD-File utilities for 391.98 ;08/26/97
2 ;;5.3;Registration;**149,307,479**;Aug 13, 1993
3 ;
4 ;Check for null incoming data elements to fire outgoing update
5EN ;SEX - .02 - VADM(5)
6 I (@VAFCB@(2,.02)[U),($P(VADM(5),U,2)]"") S VAFCQ(1)=1 G CHQ
7 ;MARITAL STATUS - .05 - VADM(10)
8 I (@VAFCB@(2,.05)="""@"""),($P(VADM(10),U,2)]"") S VAFCQ(1)=1 G CHQ
9 ;STREET ADDRESS [1] - .111 - VAPA(1)
10 ;I (@VAFCB@(2,.111)="""@"""),(VAPA(1)]""),(VAFCF'[".111;") S VAFCQ(1)=1 G CHQ ;**479
11 ;STREET ADDRESS [2] - .112 - VAPA(2)
12 ;I (@VAFCB@(2,.112)="""@"""),(VAFCF'[".112;"),(VAPA(2)]"") S VAFCQ(1)=1 G CHQ ;**479
13 ;STREET ADDRESS [3] - .113 - VAPA(3)
14 ;I (@VAFCB@(2,.113)="""@"""),(VAFCF'[".113;"),(VAPA(3)]"") S VAFCQ(1)=1 G CHQ ;**479
15 ;CITY - .114 - VAPA(4)
16 ;I (@VAFCB@(2,.114)="""@"""),(VAFCF'[".114;"),(VAPA(4)]"") S VAFCQ(1)=1 G CHQ ;**479
17 ;STATE - .115 - VAPA(5)
18 ;I (@VAFCB@(2,.115)="""@"""),(VAFCF'[".115;"),($P(VAPA(5),U,2)]"") S VAFCQ(1)=1 G CHQ ;**479
19 ;ZIP+4 - .1112 - VAPA(11)
20 ;I (@VAFCB@(2,.1112)="""@"""),(VAFCF'[".1112;"),($P(VAPA(11),U)]"") S VAFCQ(1)=1 G CHQ ;**479
21 ;COUNTY CODE - .117 - VAPA(7)
22 ;I '@VAFCB@(2,.117)!(@VAFCB@(2,.117)="""@"""),(VAFCF'[".117;"),$P(VAPA(7),U) S VAFCQ(1)=1 G CHQ ;**479
23 ;PHONE HOME - .131 - VAPA(8)
24 I (@VAFCB@(2,.131)="""@"""),(VAFCF'[".131;"),(VAPA(8)]"") S VAFCQ(1)=1 G CHQ
25 ;PHONE WORK - .132 - VAPA(2,DFN,.132)
26 I (@VAFCB@(2,.132)="""@"""),(VAFCF'[".132;"),(VAPA(2,DFN_",",.132)]"") S VAFCQ(1)=1 G CHQ
27 ;K-NAME - .211 - VAPA(2,DFN,.211)
28 I (@VAFCB@(2,.211)="""@"""),(VAFCF'[".211;"),(VAPA(2,DFN_",",.211)]"") S VAFCQ(1)=1 G CHQ
29 ;K-PHONE - .219 - VAPA(2,DFN,.219)
30 I (@VAFCB@(2,.219)="""@"""),(VAFCF'[".219;"),(VAPA(2,DFN_",",.219)]"") S VAFCQ(1)=1 G CHQ
31 ;MOTHER'S MAIDEN NAME - .2403 - VAPA(2,DFN,.2403)
32 I (@VAFCB@(2,.2403)="""@"""),(VAPA(2,DFN_",",.2403)]"") S VAFCQ(1)=1 G CHQ
33 ;SERVICE CONNECTED - .301 - VAPA(2,DFN,.301)
34 ;I (@VAFCB@(2,.301)="""@"""),(VAPA(2,DFN_",",.301)]"") S VAFCQ(1)=1 G CHQ
35 ;SC% - .302 - VAPA(2,DFN,.302)
36 ;I '@VAFCB@(2,.302),VAPA(2,DFN_",",.302) S VAFCQ=1 G CHQ
37 ;EMPLOYMENT STATUS - .31115 - VAPA(2,DFN,.31115)
38 I (@VAFCB@(2,.31115)="""@"""),(VAPA(2,DFN_",",.31115)]"") S VAFCQ(1)=1 G CHQ
39 ;PERIOD OF SERVICE - .323 - VAPA(2,DFN,.323)
40 ;I (@VAFCB@(2,.323)="""@"""),(VAPA(2,DFN_",",.323)]"") S VAFCQ(1)=1 G CHQ
41 ;DATE OF DEATH - .351 - VAPA(2,DFN,.351)
42 I (@VAFCB@(2,.351)="""@"""),VAPA(2,DFN_",",.351) S VAFCQ(1)=1 G CHQ
43 ;PRIMARY ELIG CODE - .361 - VAPA(2,DFN,.361)
44 ;I (@VAFCB@(2,.361)]"")&(@VAFCB@(2,.361)'=VAPA(2,DFN_",",.361))!((@VAFCB@(2,.361)="")&((VAFCF[".361;"))&((@VAFCB@(2,.361)'=VAPA(2,DFN_",",.361)))) S VAFCQ=1 G CHQ
45 ;PATIENT TYPE - 391 - VAPA(2,DFN,391)
46 ;I (@VAFCB@(2,391)="""@"""),(VAPA(2,DFN_",",391)]"") S VAFCQ(1)=1 G CHQ
47 ;VETERAN (Y/N) - 1901 - VAPA(2,DFN,1901)
48 ;I (@VAFCB@(2,1901)="""@"""),VAPA(2,DFN_",",1901) S VAFCQ(1)=1
49CHQ I $G(VAFCQ(1)) D AVAFC^VAFCDD01(DFN)
50 Q
51 ;
52WHO(X) ; determine the identity of the sending facility, resolve it into
53 ; the institution name. Prior to the release of RG*1*8, the sending
54 ; facility was passed as the name of the institution. After the
55 ; release of RG*1*8, the sending facility is passed in either
56 ; format: station # -or- station #~domain. The station # needs
57 ; to be resolved into the name of the institution.
58 ; called from: ADD^VAFCEHU1 & CHK^VAFCEHU1
59 ; INPUT X-string: sending facility (see desc for possible formats)
60 Q:X="" "" N WHO
61 I $$PATCH^XPDUTL("RG*1.0*8") D ; passed as station# or station#~domain
62 .S WHO=+X ; obtain station #
63 .S WHO=$$LKUP^XUAF4(WHO) ; from station # to ien
64 .S WHO=$$GET1^DIQ(4,+WHO_",",.01) ; from ien to name
65 .Q
66 E S WHO=X ; before RG*1.0*8, passed as institution name
67 Q $G(WHO)
Note: See TracBrowser for help on using the repository browser.