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

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

initial load of WorldVistAEHR
File size: 6.0 KB
RevLine 
[613]1VAFCEHU3 ;BIR/LTL,PTD-File utilities for 391.98 ;10/23/02
2 ;;5.3;Registration;**149,295,384,474,477,479,620,756**;Aug 13, 1993;Build 5
3 ;
4 ;Check for select fields that if edited can update without review
5EN ;
6 N VAFC,VAFCE,VAFCF S VAFCF=1
7 ;Save the array so a new one can be built for edit
8 M VAFC=@VAFCB K @VAFCB
9 F S VAFCE=$P(VAFC(2,"FLD"),";",VAFCF) Q:'VAFCE S VAFCF=VAFCF+1 D
10 .Q:(VAFCE>.01&(VAFCE<.111))!(VAFCE>.219)
11 .S @VAFCB@(2,VAFCE)=$G(VAFC(2,VAFCE)) ;**756 added $get
12 ;save the sending site's station number
13 I $D(VAFC(2,"SENDING SITE")) S @VAFCB@(2,"SENDING SITE")=VAFC(2,"SENDING SITE")
14ED ;D:$D(VAFCB) EDIT^VAFCPTED(PAT,VAFCB_"(2)",".01") ;**295 auto-updated fields - removed .111;.112;.113;.114;.115;.1112;.117;.131;.132;.211;.219 ;**474 stop all auto-updates
15 ;restore the array for possible exceptions
16 M @VAFCB=VAFC
17CH ;Any differences?
18 N DFN,DGNAME ;**295,**384
19 S DFN=PAT,VAFCQ=0,VAFCF=@VAFCB@(2,"FLD") D DEM^VADPT
20 ;reformat problem data
21 I @VAFCB@(2,.05)="N" S @VAFCB@(2,.05)="NEVER MARRIED" ;**477
22 ;If not null and different or null and edited and different,
23 ;we got an exception, we're out of here
24 ;NAME - .01 - VADM(1)
25 I '$$COMP^VAFCUTL(VADM(1),@VAFCB@(2,.01)) S VAFCQ=1 G CHQ
26 ;SEX - .02 - VADM(5)
27 I (@VAFCB@(2,.02)'[U)&(($P(VADM(5),U,2)'=@VAFCB@(2,.02))) S VAFCQ=1 G CHQ
28 ;DOB - .03 - VADM(3)
29 I (@VAFCB@(2,.03)'=$P(VADM(3),U)) S VAFCQ=1 G CHQ
30 ;MARITAL STATUS - .05 - VADM(10)
31 I (@VAFCB@(2,.05)'="""@"""),($P(VADM(10),U,2)'=@VAFCB@(2,.05)),(@VAFCB@(2,.05)'[U) S VAFCQ=1 G CHQ
32 ;RELIGION - .08 - VADM(9)
33 I (@VAFCB@(2,.08)'[U),($P(VADM(9),U,2)'=@VAFCB@(2,.08)) S VAFCQ=1 G CHQ
34 ;SSN - .09 - VADM(2)
35 I (@VAFCB@(2,.09)'=$P(VADM(2),U)) S VAFCQ=1 G CHQ
36 ;get some address stuff
37 D ADD^VADPT
38 ;STREET ADDRESS [1] - .111 - VAPA(1)
39 ;I (@VAFCB@(2,.111)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.111),VAPA(1)) S VAFCQ=1 G CHQ ;**479
40 ;STREET ADDRESS [2] - .112 - VAPA(2)
41 ;I (@VAFCB@(2,.112)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.112),VAPA(2)) S VAFCQ=1 G CHQ ;**479
42 ;STREET ADDRESS [3] - .113 - VAPA(3)
43 ;I (@VAFCB@(2,.113)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.113),VAPA(3)) S VAFCQ=1 G CHQ ;**479
44 ;CITY - .114 - VAPA(4)
45 ;I (@VAFCB@(2,.114)'="""@"""),'$$COMP^VAFCUTL(VAPA(4),@VAFCB@(2,.114)) S VAFCQ=1 G CHQ ;**479
46 ;STATE - .115 - VAPA(5)
47 ;I (@VAFCB@(2,.115)'="""@"""),($P(VAPA(5),U,2)'=@VAFCB@(2,.115)) S VAFCQ=1 G CHQ ;**479
48 ;ZIP+4 - .1112 - VAPA(11)
49 ;I (@VAFCB@(2,.1112)'="""@"""),(@VAFCB@(2,.1112)'=$P(VAPA(11),U,2)) S VAFCQ=1 G CHQ ;**477 added u,2) ;**479
50 ;COUNTY CODE - .117 - VAPA(7)
51 ;I @VAFCB@(2,.117),(@VAFCB@(2,.117)'=$P(VAPA(7),U)) S VAFCQ=1 G CHQ ;**479
52 ;PHONE HOME - .131 - VAPA(8)
53 I ($G(@VAFCB@(2,.131))'="""@"""),'$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(8)),$$HLPHONE^HLFNC($G(@VAFCB@(2,.131)))) S VAFCQ=1 G CHQ ;**384 ;**756 added $get's
54 ;Get the rest
55 D GETS^DIQ(2,DFN_",",".132;.211;.219;.2403;.301;.302;.31115;.323;.361;391;1901","","VAPA")
56 ;PHONE WORK - .132 - VAPA(2,DFN,.132)
57 I ($G(@VAFCB@(2,.132))'="""@"""),'$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(2,DFN_",",.132)),$$HLPHONE^HLFNC($G(@VAFCB@(2,.132)))) S VAFCQ=1 G CHQ ;**384 ;**756 added $get's
58 ;K-NAME - .211 - VAPA(2,DFN,.211)
59 I $S(VAPA(2,DFN_",",.211)="":0,1:1) S DGNAME=VAPA(2,DFN_",",.211) D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35),VAPA(2,DFN_",",.211)=DGNAME ;**384 **477
60 I $S(@VAFCB@(2,.211)="":0,@VAFCB@(2,.211)["@":0,1:1) S DGNAME=@VAFCB@(2,.211) D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35),@VAFCB@(2,.211)=DGNAME ;**384 **477
61 I (@VAFCB@(2,.211)'="""@"""),'$$COMP^VAFCUTL(VAPA(2,DFN_",",.211),@VAFCB@(2,.211)) S VAFCQ=1 G CHQ
62 ;K-PHONE - .219 - VAPA(2,DFN,.219)
63 I (@VAFCB@(2,.219)'="""@"""),'$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(2,DFN_",",.219)),$$HLPHONE^HLFNC(@VAFCB@(2,.219))) S VAFCQ=1 G CHQ ;**384
64 ;MOTHER'S MAIDEN NAME - .2403 - VAPA(2,DFN,.2403)
65 I $S(VAPA(2,DFN_",",.2403)="":0,1:1) S DGNAME=VAPA(2,DFN_",",.2403) D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35,,2,,1),VAPA(2,DFN_",",.2403)=DGNAME ;**384 **477
66 I $S(@VAFCB@(2,.2403)="":0,@VAFCB@(2,.2403)["@":0,1:1) S DGNAME=@VAFCB@(2,.2403) D STDNAME^XLFNAME(.DGNAME,"P") S DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35,,2,,1),@VAFCB@(2,.2403)=DGNAME ;**384 **477
67 I ((@VAFCB@(2,.2403)'="""@""")&('$$COMP^VAFCUTL(VAPA(2,DFN_",",.2403),@VAFCB@(2,.2403))))!((@VAFCB@(2,.2403)="""@""")&((VAFCF[".2403;"))&((VAPA(2,DFN_",",.2403)]""))) S VAFCQ=1 G CHQ
68 ;SERVICE CONNECTED - .301 - VAPA(2,DFN,.301)
69 ;I ((@VAFCB@(2,.301)'="""@""")&((VAPA(2,DFN_",",.301)'=@VAFCB@(2,.301))))!((@VAFCB@(2,.301)="""@""")&((VAFCF[".301;"))&((VAPA(2,DFN_",",.301)]""))) S VAFCQ=1 G CHQ
70 ;SC% - .302 - VAPA(2,DFN,.302)
71 ;I (@VAFCB@(2,.302)&((VAPA(2,DFN_",",.302)'=@VAFCB@(2,.302))))!((@VAFCB@(2,.302)="""@""")&((VAFCF[".302;"))&((VAPA(2,DFN_",",.302)]""))) S VAFCQ=1 G CHQ
72 ;EMPLOYMENT STATUS - .31115 - VAPA(2,DFN,.31115)
73 I ((@VAFCB@(2,.31115)'="""@""")&((VAPA(2,DFN_",",.31115)'=@VAFCB@(2,.31115))))!((@VAFCB@(2,.31115)="""@""")&((VAFCF[".31115;"))&((VAPA(2,DFN_",",.31115)]""))) S VAFCQ=1 G CHQ
74 ;PERIOD OF SERVICE - .323 - VAPA(2,DFN,.323)
75 ;I ((@VAFCB@(2,.323)'="""@""")&((VAPA(2,DFN_",",.323)'=@VAFCB@(2,.323))))!((@VAFCB@(2,.323)="""@""")&((VAFCF[".323;"))&((VAPA(2,DFN_",",.323)]""))) S VAFCQ=1 G CHQ
76 ;DATE OF DEATH - .351 - VAPA(2,DFN,.351)
77 S VAPA(2,DFN_",",.351)=$$GET1^DIQ(2,DFN_",",.351,"I")
78 I ((@VAFCB@(2,.351)'="""@""")&((@VAFCB@(2,.351)'=VAPA(2,DFN_",",.351))))!((@VAFCB@(2,.351)="""@""")&((VAFCF[".351"))&(VAPA(2,DFN_",",.351))) S VAFCQ=1 G CHQ
79 ;PRIMARY ELIG CODE - .361 - VAPA(2,DFN,.361)
80 ;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
81 ;PATIENT TYPE - 391 - VAPA(2,DFN,391)
82 ;I ((@VAFCB@(2,391)'="""@""")&(@VAFCB@(2,391)'=VAPA(2,DFN_",",391)))!((@VAFCB@(2,391)="""@""")&((VAFCF["391;"))&((VAPA(2,DFN_",",391)]""))) S VAFCQ=1 G CHQ
83 ;VETERAN (Y/N) - 1901 - VAPA(2,DFN,1901)
84 ;I ((@VAFCB@(2,1901)'="""@""")&(@VAFCB@(2,1901)'=VAPA(2,DFN_",",1901)))!((@VAFCB@(2,1901)="""@""")&((VAFCF["1901;"))&((VAPA(2,DFN_",",1901)]""))) S VAFCQ=1
85CHQ D:'$G(VAFCQ) EN^VAFCEHU4
86 D KVA^VADPT Q
Note: See TracBrowser for help on using the repository browser.