- VAFCEHU3 ;BIR/LTL,PTD-File utilities for 391.98 ;10/23/02
- ;;5.3;Registration;**149,295,384,474,477,479,620,756**;Aug 13, 1993;Build 5
- ;
- ;Check for select fields that if edited can update without review
- EN ;
- N VAFC,VAFCE,VAFCF S VAFCF=1
- ;Save the array so a new one can be built for edit
- M VAFC=@VAFCB K @VAFCB
- F S VAFCE=$P(VAFC(2,"FLD"),";",VAFCF) Q:'VAFCE S VAFCF=VAFCF+1 D
- .Q:(VAFCE>.01&(VAFCE<.111))!(VAFCE>.219)
- .S @VAFCB@(2,VAFCE)=$G(VAFC(2,VAFCE)) ;**756 added $get
- ;save the sending site's station number
- I $D(VAFC(2,"SENDING SITE")) S @VAFCB@(2,"SENDING SITE")=VAFC(2,"SENDING SITE")
- ED ;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
- ;restore the array for possible exceptions
- M @VAFCB=VAFC
- CH ;Any differences?
- N DFN,DGNAME ;**295,**384
- S DFN=PAT,VAFCQ=0,VAFCF=@VAFCB@(2,"FLD") D DEM^VADPT
- ;reformat problem data
- I @VAFCB@(2,.05)="N" S @VAFCB@(2,.05)="NEVER MARRIED" ;**477
- ;If not null and different or null and edited and different,
- ;we got an exception, we're out of here
- ;NAME - .01 - VADM(1)
- I '$$COMP^VAFCUTL(VADM(1),@VAFCB@(2,.01)) S VAFCQ=1 G CHQ
- ;SEX - .02 - VADM(5)
- I (@VAFCB@(2,.02)'[U)&(($P(VADM(5),U,2)'=@VAFCB@(2,.02))) S VAFCQ=1 G CHQ
- ;DOB - .03 - VADM(3)
- I (@VAFCB@(2,.03)'=$P(VADM(3),U)) S VAFCQ=1 G CHQ
- ;MARITAL STATUS - .05 - VADM(10)
- I (@VAFCB@(2,.05)'="""@"""),($P(VADM(10),U,2)'=@VAFCB@(2,.05)),(@VAFCB@(2,.05)'[U) S VAFCQ=1 G CHQ
- ;RELIGION - .08 - VADM(9)
- I (@VAFCB@(2,.08)'[U),($P(VADM(9),U,2)'=@VAFCB@(2,.08)) S VAFCQ=1 G CHQ
- ;SSN - .09 - VADM(2)
- I (@VAFCB@(2,.09)'=$P(VADM(2),U)) S VAFCQ=1 G CHQ
- ;get some address stuff
- D ADD^VADPT
- ;STREET ADDRESS [1] - .111 - VAPA(1)
- ;I (@VAFCB@(2,.111)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.111),VAPA(1)) S VAFCQ=1 G CHQ ;**479
- ;STREET ADDRESS [2] - .112 - VAPA(2)
- ;I (@VAFCB@(2,.112)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.112),VAPA(2)) S VAFCQ=1 G CHQ ;**479
- ;STREET ADDRESS [3] - .113 - VAPA(3)
- ;I (@VAFCB@(2,.113)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.113),VAPA(3)) S VAFCQ=1 G CHQ ;**479
- ;CITY - .114 - VAPA(4)
- ;I (@VAFCB@(2,.114)'="""@"""),'$$COMP^VAFCUTL(VAPA(4),@VAFCB@(2,.114)) S VAFCQ=1 G CHQ ;**479
- ;STATE - .115 - VAPA(5)
- ;I (@VAFCB@(2,.115)'="""@"""),($P(VAPA(5),U,2)'=@VAFCB@(2,.115)) S VAFCQ=1 G CHQ ;**479
- ;ZIP+4 - .1112 - VAPA(11)
- ;I (@VAFCB@(2,.1112)'="""@"""),(@VAFCB@(2,.1112)'=$P(VAPA(11),U,2)) S VAFCQ=1 G CHQ ;**477 added u,2) ;**479
- ;COUNTY CODE - .117 - VAPA(7)
- ;I @VAFCB@(2,.117),(@VAFCB@(2,.117)'=$P(VAPA(7),U)) S VAFCQ=1 G CHQ ;**479
- ;PHONE HOME - .131 - VAPA(8)
- 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
- ;Get the rest
- D GETS^DIQ(2,DFN_",",".132;.211;.219;.2403;.301;.302;.31115;.323;.361;391;1901","","VAPA")
- ;PHONE WORK - .132 - VAPA(2,DFN,.132)
- 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
- ;K-NAME - .211 - VAPA(2,DFN,.211)
- 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
- 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
- I (@VAFCB@(2,.211)'="""@"""),'$$COMP^VAFCUTL(VAPA(2,DFN_",",.211),@VAFCB@(2,.211)) S VAFCQ=1 G CHQ
- ;K-PHONE - .219 - VAPA(2,DFN,.219)
- I (@VAFCB@(2,.219)'="""@"""),'$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(2,DFN_",",.219)),$$HLPHONE^HLFNC(@VAFCB@(2,.219))) S VAFCQ=1 G CHQ ;**384
- ;MOTHER'S MAIDEN NAME - .2403 - VAPA(2,DFN,.2403)
- 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
- 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
- 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
- ;SERVICE CONNECTED - .301 - VAPA(2,DFN,.301)
- ;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
- ;SC% - .302 - VAPA(2,DFN,.302)
- ;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
- ;EMPLOYMENT STATUS - .31115 - VAPA(2,DFN,.31115)
- 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
- ;PERIOD OF SERVICE - .323 - VAPA(2,DFN,.323)
- ;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
- ;DATE OF DEATH - .351 - VAPA(2,DFN,.351)
- S VAPA(2,DFN_",",.351)=$$GET1^DIQ(2,DFN_",",.351,"I")
- 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
- ;PRIMARY ELIG CODE - .361 - VAPA(2,DFN,.361)
- ;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
- ;PATIENT TYPE - 391 - VAPA(2,DFN,391)
- ;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
- ;VETERAN (Y/N) - 1901 - VAPA(2,DFN,1901)
- ;I ((@VAFCB@(2,1901)'="""@""")&(@VAFCB@(2,1901)'=VAPA(2,DFN_",",1901)))!((@VAFCB@(2,1901)="""@""")&((VAFCF["1901;"))&((VAPA(2,DFN_",",1901)]""))) S VAFCQ=1
- CHQ D:'$G(VAFCQ) EN^VAFCEHU4
- D KVA^VADPT Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCEHU3 6228 printed Apr 23, 2025@19:15:45 Page 2
- VAFCEHU3 ;BIR/LTL,PTD-File utilities for 391.98 ;10/23/02
- +1 ;;5.3;Registration;**149,295,384,474,477,479,620,756**;Aug 13, 1993;Build 5
- +2 ;
- +3 ;Check for select fields that if edited can update without review
- EN ;
- +1 NEW VAFC,VAFCE,VAFCF
- SET VAFCF=1
- +2 ;Save the array so a new one can be built for edit
- +3 MERGE VAFC=@VAFCB
- KILL @VAFCB
- +4 FOR
- SET VAFCE=$PIECE(VAFC(2,"FLD"),";",VAFCF)
- if 'VAFCE
- QUIT
- SET VAFCF=VAFCF+1
- Begin DoDot:1
- +5 if (VAFCE>.01&(VAFCE<.111))!(VAFCE>.219)
- QUIT
- +6 ;**756 added $get
- SET @VAFCB@(2,VAFCE)=$GET(VAFC(2,VAFCE))
- End DoDot:1
- +7 ;save the sending site's station number
- +8 IF $DATA(VAFC(2,"SENDING SITE"))
- SET @VAFCB@(2,"SENDING SITE")=VAFC(2,"SENDING SITE")
- ED ;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
- +1 ;restore the array for possible exceptions
- +2 MERGE @VAFCB=VAFC
- CH ;Any differences?
- +1 ;**295,**384
- NEW DFN,DGNAME
- +2 SET DFN=PAT
- SET VAFCQ=0
- SET VAFCF=@VAFCB@(2,"FLD")
- DO DEM^VADPT
- +3 ;reformat problem data
- +4 ;**477
- IF @VAFCB@(2,.05)="N"
- SET @VAFCB@(2,.05)="NEVER MARRIED"
- +5 ;If not null and different or null and edited and different,
- +6 ;we got an exception, we're out of here
- +7 ;NAME - .01 - VADM(1)
- +8 IF '$$COMP^VAFCUTL(VADM(1),@VAFCB@(2,.01))
- SET VAFCQ=1
- GOTO CHQ
- +9 ;SEX - .02 - VADM(5)
- +10 IF (@VAFCB@(2,.02)'[U)&(($PIECE(VADM(5),U,2)'=@VAFCB@(2,.02)))
- SET VAFCQ=1
- GOTO CHQ
- +11 ;DOB - .03 - VADM(3)
- +12 IF (@VAFCB@(2,.03)'=$PIECE(VADM(3),U))
- SET VAFCQ=1
- GOTO CHQ
- +13 ;MARITAL STATUS - .05 - VADM(10)
- +14 IF (@VAFCB@(2,.05)'="""@""")
- IF ($PIECE(VADM(10),U,2)'=@VAFCB@(2,.05))
- IF (@VAFCB@(2,.05)'[U)
- SET VAFCQ=1
- GOTO CHQ
- +15 ;RELIGION - .08 - VADM(9)
- +16 IF (@VAFCB@(2,.08)'[U)
- IF ($PIECE(VADM(9),U,2)'=@VAFCB@(2,.08))
- SET VAFCQ=1
- GOTO CHQ
- +17 ;SSN - .09 - VADM(2)
- +18 IF (@VAFCB@(2,.09)'=$PIECE(VADM(2),U))
- SET VAFCQ=1
- GOTO CHQ
- +19 ;get some address stuff
- +20 DO ADD^VADPT
- +21 ;STREET ADDRESS [1] - .111 - VAPA(1)
- +22 ;I (@VAFCB@(2,.111)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.111),VAPA(1)) S VAFCQ=1 G CHQ ;**479
- +23 ;STREET ADDRESS [2] - .112 - VAPA(2)
- +24 ;I (@VAFCB@(2,.112)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.112),VAPA(2)) S VAFCQ=1 G CHQ ;**479
- +25 ;STREET ADDRESS [3] - .113 - VAPA(3)
- +26 ;I (@VAFCB@(2,.113)'="""@"""),'$$COMP^VAFCUTL(@VAFCB@(2,.113),VAPA(3)) S VAFCQ=1 G CHQ ;**479
- +27 ;CITY - .114 - VAPA(4)
- +28 ;I (@VAFCB@(2,.114)'="""@"""),'$$COMP^VAFCUTL(VAPA(4),@VAFCB@(2,.114)) S VAFCQ=1 G CHQ ;**479
- +29 ;STATE - .115 - VAPA(5)
- +30 ;I (@VAFCB@(2,.115)'="""@"""),($P(VAPA(5),U,2)'=@VAFCB@(2,.115)) S VAFCQ=1 G CHQ ;**479
- +31 ;ZIP+4 - .1112 - VAPA(11)
- +32 ;I (@VAFCB@(2,.1112)'="""@"""),(@VAFCB@(2,.1112)'=$P(VAPA(11),U,2)) S VAFCQ=1 G CHQ ;**477 added u,2) ;**479
- +33 ;COUNTY CODE - .117 - VAPA(7)
- +34 ;I @VAFCB@(2,.117),(@VAFCB@(2,.117)'=$P(VAPA(7),U)) S VAFCQ=1 G CHQ ;**479
- +35 ;PHONE HOME - .131 - VAPA(8)
- +36 ;**384 ;**756 added $get's
- IF ($GET(@VAFCB@(2,.131))'="""@""")
- IF '$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(8)),$$HLPHONE^HLFNC($GET(@VAFCB@(2,.131))))
- SET VAFCQ=1
- GOTO CHQ
- +37 ;Get the rest
- +38 DO GETS^DIQ(2,DFN_",",".132;.211;.219;.2403;.301;.302;.31115;.323;.361;391;1901","","VAPA")
- +39 ;PHONE WORK - .132 - VAPA(2,DFN,.132)
- +40 ;**384 ;**756 added $get's
- IF ($GET(@VAFCB@(2,.132))'="""@""")
- IF '$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(2,DFN_",",.132)),$$HLPHONE^HLFNC($GET(@VAFCB@(2,.132))))
- SET VAFCQ=1
- GOTO CHQ
- +41 ;K-NAME - .211 - VAPA(2,DFN,.211)
- +42 ;**384 **477
- IF $SELECT(VAPA(2,DFN_",",.211)="":0,1:1)
- SET DGNAME=VAPA(2,DFN_",",.211)
- DO STDNAME^XLFNAME(.DGNAME,"P")
- SET DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35)
- SET VAPA(2,DFN_",",.211)=DGNAME
- +43 ;**384 **477
- IF $SELECT(@VAFCB@(2,.211)="":0,@VAFCB@(2,.211)["@":0,1:1)
- SET DGNAME=@VAFCB@(2,.211)
- DO STDNAME^XLFNAME(.DGNAME,"P")
- SET DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35)
- SET @VAFCB@(2,.211)=DGNAME
- +44 IF (@VAFCB@(2,.211)'="""@""")
- IF '$$COMP^VAFCUTL(VAPA(2,DFN_",",.211),@VAFCB@(2,.211))
- SET VAFCQ=1
- GOTO CHQ
- +45 ;K-PHONE - .219 - VAPA(2,DFN,.219)
- +46 ;**384
- IF (@VAFCB@(2,.219)'="""@""")
- IF '$$COMP^VAFCUTL($$HLPHONE^HLFNC(VAPA(2,DFN_",",.219)),$$HLPHONE^HLFNC(@VAFCB@(2,.219)))
- SET VAFCQ=1
- GOTO CHQ
- +47 ;MOTHER'S MAIDEN NAME - .2403 - VAPA(2,DFN,.2403)
- +48 ;**384 **477
- IF $SELECT(VAPA(2,DFN_",",.2403)="":0,1:1)
- SET DGNAME=VAPA(2,DFN_",",.2403)
- DO STDNAME^XLFNAME(.DGNAME,"P")
- SET DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35,,2,,1)
- SET VAPA(2,DFN_",",.2403)=DGNAME
- +49 ;**384 **477
- IF $SELECT(@VAFCB@(2,.2403)="":0,@VAFCB@(2,.2403)["@":0,1:1)
- SET DGNAME=@VAFCB@(2,.2403)
- DO STDNAME^XLFNAME(.DGNAME,"P")
- SET DGNAME=$$FORMAT^XLFNAME7(.DGNAME,3,35,,2,,1)
- SET @VAFCB@(2,.2403)=DGNAME
- +50 IF ((@VAFCB@(2,.2403)'="""@""")&('$$COMP^VAFCUTL(VAPA(2,DFN_",",.2403),@VAFCB@(2,.2403))))!((@VAFCB@(2,.2403)="""@""")&((VAFCF[".2403;"))&((VAPA(2,DFN_",",.2403)]"")))
- SET VAFCQ=1
- GOTO CHQ
- +51 ;SERVICE CONNECTED - .301 - VAPA(2,DFN,.301)
- +52 ;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
- +53 ;SC% - .302 - VAPA(2,DFN,.302)
- +54 ;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
- +55 ;EMPLOYMENT STATUS - .31115 - VAPA(2,DFN,.31115)
- +56 IF ((@VAFCB@(2,.31115)'="""@""")&((VAPA(2,DFN_",",.31115)'=@VAFCB@(2,.31115))))!((@VAFCB@(2,.31115)="""@""")&((VAFCF[".31115;"))&((VAPA(2,DFN_",",.31115)]"")))
- SET VAFCQ=1
- GOTO CHQ
- +57 ;PERIOD OF SERVICE - .323 - VAPA(2,DFN,.323)
- +58 ;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
- +59 ;DATE OF DEATH - .351 - VAPA(2,DFN,.351)
- +60 SET VAPA(2,DFN_",",.351)=$$GET1^DIQ(2,DFN_",",.351,"I")
- +61 IF ((@VAFCB@(2,.351)'="""@""")&((@VAFCB@(2,.351)'=VAPA(2,DFN_",",.351))))!((@VAFCB@(2,.351)="""@""")&((VAFCF[".351"))&(VAPA(2,DFN_",",.351)))
- SET VAFCQ=1
- GOTO CHQ
- +62 ;PRIMARY ELIG CODE - .361 - VAPA(2,DFN,.361)
- +63 ;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
- +64 ;PATIENT TYPE - 391 - VAPA(2,DFN,391)
- +65 ;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
- +66 ;VETERAN (Y/N) - 1901 - VAPA(2,DFN,1901)
- +67 ;I ((@VAFCB@(2,1901)'="""@""")&(@VAFCB@(2,1901)'=VAPA(2,DFN_",",1901)))!((@VAFCB@(2,1901)="""@""")&((VAFCF["1901;"))&((VAPA(2,DFN_",",1901)]""))) S VAFCQ=1
- CHQ if '$GET(VAFCQ)
- DO EN^VAFCEHU4
- +1 DO KVA^VADPT
- QUIT
