- VAFCEHU4 ;BIR/LTL,PTD-File utilities for 391.98 ;08/26/97
- ;;5.3;Registration;**149,307,479**;Aug 13, 1993
- ;
- ;Check for null incoming data elements to fire outgoing update
- EN ;SEX - .02 - VADM(5)
- I (@VAFCB@(2,.02)[U),($P(VADM(5),U,2)]"") S VAFCQ(1)=1 G CHQ
- ;MARITAL STATUS - .05 - VADM(10)
- I (@VAFCB@(2,.05)="""@"""),($P(VADM(10),U,2)]"") S VAFCQ(1)=1 G CHQ
- ;STREET ADDRESS [1] - .111 - VAPA(1)
- ;I (@VAFCB@(2,.111)="""@"""),(VAPA(1)]""),(VAFCF'[".111;") S VAFCQ(1)=1 G CHQ ;**479
- ;STREET ADDRESS [2] - .112 - VAPA(2)
- ;I (@VAFCB@(2,.112)="""@"""),(VAFCF'[".112;"),(VAPA(2)]"") S VAFCQ(1)=1 G CHQ ;**479
- ;STREET ADDRESS [3] - .113 - VAPA(3)
- ;I (@VAFCB@(2,.113)="""@"""),(VAFCF'[".113;"),(VAPA(3)]"") S VAFCQ(1)=1 G CHQ ;**479
- ;CITY - .114 - VAPA(4)
- ;I (@VAFCB@(2,.114)="""@"""),(VAFCF'[".114;"),(VAPA(4)]"") S VAFCQ(1)=1 G CHQ ;**479
- ;STATE - .115 - VAPA(5)
- ;I (@VAFCB@(2,.115)="""@"""),(VAFCF'[".115;"),($P(VAPA(5),U,2)]"") S VAFCQ(1)=1 G CHQ ;**479
- ;ZIP+4 - .1112 - VAPA(11)
- ;I (@VAFCB@(2,.1112)="""@"""),(VAFCF'[".1112;"),($P(VAPA(11),U)]"") S VAFCQ(1)=1 G CHQ ;**479
- ;COUNTY CODE - .117 - VAPA(7)
- ;I '@VAFCB@(2,.117)!(@VAFCB@(2,.117)="""@"""),(VAFCF'[".117;"),$P(VAPA(7),U) S VAFCQ(1)=1 G CHQ ;**479
- ;PHONE HOME - .131 - VAPA(8)
- I (@VAFCB@(2,.131)="""@"""),(VAFCF'[".131;"),(VAPA(8)]"") S VAFCQ(1)=1 G CHQ
- ;PHONE WORK - .132 - VAPA(2,DFN,.132)
- I (@VAFCB@(2,.132)="""@"""),(VAFCF'[".132;"),(VAPA(2,DFN_",",.132)]"") S VAFCQ(1)=1 G CHQ
- ;K-NAME - .211 - VAPA(2,DFN,.211)
- I (@VAFCB@(2,.211)="""@"""),(VAFCF'[".211;"),(VAPA(2,DFN_",",.211)]"") S VAFCQ(1)=1 G CHQ
- ;K-PHONE - .219 - VAPA(2,DFN,.219)
- I (@VAFCB@(2,.219)="""@"""),(VAFCF'[".219;"),(VAPA(2,DFN_",",.219)]"") S VAFCQ(1)=1 G CHQ
- ;MOTHER'S MAIDEN NAME - .2403 - VAPA(2,DFN,.2403)
- I (@VAFCB@(2,.2403)="""@"""),(VAPA(2,DFN_",",.2403)]"") S VAFCQ(1)=1 G CHQ
- ;SERVICE CONNECTED - .301 - VAPA(2,DFN,.301)
- ;I (@VAFCB@(2,.301)="""@"""),(VAPA(2,DFN_",",.301)]"") S VAFCQ(1)=1 G CHQ
- ;SC% - .302 - VAPA(2,DFN,.302)
- ;I '@VAFCB@(2,.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)]"") S VAFCQ(1)=1 G CHQ
- ;PERIOD OF SERVICE - .323 - VAPA(2,DFN,.323)
- ;I (@VAFCB@(2,.323)="""@"""),(VAPA(2,DFN_",",.323)]"") S VAFCQ(1)=1 G CHQ
- ;DATE OF DEATH - .351 - VAPA(2,DFN,.351)
- I (@VAFCB@(2,.351)="""@"""),VAPA(2,DFN_",",.351) S VAFCQ(1)=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)="""@"""),(VAPA(2,DFN_",",391)]"") S VAFCQ(1)=1 G CHQ
- ;VETERAN (Y/N) - 1901 - VAPA(2,DFN,1901)
- ;I (@VAFCB@(2,1901)="""@"""),VAPA(2,DFN_",",1901) S VAFCQ(1)=1
- CHQ I $G(VAFCQ(1)) D AVAFC^VAFCDD01(DFN)
- Q
- ;
- WHO(X) ; determine the identity of the sending facility, resolve it into
- ; the institution name. Prior to the release of RG*1*8, the sending
- ; facility was passed as the name of the institution. After the
- ; release of RG*1*8, the sending facility is passed in either
- ; format: station # -or- station #~domain. The station # needs
- ; to be resolved into the name of the institution.
- ; called from: ADD^VAFCEHU1 & CHK^VAFCEHU1
- ; INPUT X-string: sending facility (see desc for possible formats)
- Q:X="" "" N WHO
- I $$PATCH^XPDUTL("RG*1.0*8") D ; passed as station# or station#~domain
- .S WHO=+X ; obtain station #
- .S WHO=$$LKUP^XUAF4(WHO) ; from station # to ien
- .S WHO=$$GET1^DIQ(4,+WHO_",",.01) ; from ien to name
- .Q
- E S WHO=X ; before RG*1.0*8, passed as institution name
- Q $G(WHO)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCEHU4 3751 printed Apr 23, 2025@19:15:46 Page 2
- VAFCEHU4 ;BIR/LTL,PTD-File utilities for 391.98 ;08/26/97
- +1 ;;5.3;Registration;**149,307,479**;Aug 13, 1993
- +2 ;
- +3 ;Check for null incoming data elements to fire outgoing update
- EN ;SEX - .02 - VADM(5)
- +1 IF (@VAFCB@(2,.02)[U)
- IF ($PIECE(VADM(5),U,2)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +2 ;MARITAL STATUS - .05 - VADM(10)
- +3 IF (@VAFCB@(2,.05)="""@""")
- IF ($PIECE(VADM(10),U,2)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +4 ;STREET ADDRESS [1] - .111 - VAPA(1)
- +5 ;I (@VAFCB@(2,.111)="""@"""),(VAPA(1)]""),(VAFCF'[".111;") S VAFCQ(1)=1 G CHQ ;**479
- +6 ;STREET ADDRESS [2] - .112 - VAPA(2)
- +7 ;I (@VAFCB@(2,.112)="""@"""),(VAFCF'[".112;"),(VAPA(2)]"") S VAFCQ(1)=1 G CHQ ;**479
- +8 ;STREET ADDRESS [3] - .113 - VAPA(3)
- +9 ;I (@VAFCB@(2,.113)="""@"""),(VAFCF'[".113;"),(VAPA(3)]"") S VAFCQ(1)=1 G CHQ ;**479
- +10 ;CITY - .114 - VAPA(4)
- +11 ;I (@VAFCB@(2,.114)="""@"""),(VAFCF'[".114;"),(VAPA(4)]"") S VAFCQ(1)=1 G CHQ ;**479
- +12 ;STATE - .115 - VAPA(5)
- +13 ;I (@VAFCB@(2,.115)="""@"""),(VAFCF'[".115;"),($P(VAPA(5),U,2)]"") S VAFCQ(1)=1 G CHQ ;**479
- +14 ;ZIP+4 - .1112 - VAPA(11)
- +15 ;I (@VAFCB@(2,.1112)="""@"""),(VAFCF'[".1112;"),($P(VAPA(11),U)]"") S VAFCQ(1)=1 G CHQ ;**479
- +16 ;COUNTY CODE - .117 - VAPA(7)
- +17 ;I '@VAFCB@(2,.117)!(@VAFCB@(2,.117)="""@"""),(VAFCF'[".117;"),$P(VAPA(7),U) S VAFCQ(1)=1 G CHQ ;**479
- +18 ;PHONE HOME - .131 - VAPA(8)
- +19 IF (@VAFCB@(2,.131)="""@""")
- IF (VAFCF'[".131;")
- IF (VAPA(8)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +20 ;PHONE WORK - .132 - VAPA(2,DFN,.132)
- +21 IF (@VAFCB@(2,.132)="""@""")
- IF (VAFCF'[".132;")
- IF (VAPA(2,DFN_",",.132)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +22 ;K-NAME - .211 - VAPA(2,DFN,.211)
- +23 IF (@VAFCB@(2,.211)="""@""")
- IF (VAFCF'[".211;")
- IF (VAPA(2,DFN_",",.211)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +24 ;K-PHONE - .219 - VAPA(2,DFN,.219)
- +25 IF (@VAFCB@(2,.219)="""@""")
- IF (VAFCF'[".219;")
- IF (VAPA(2,DFN_",",.219)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +26 ;MOTHER'S MAIDEN NAME - .2403 - VAPA(2,DFN,.2403)
- +27 IF (@VAFCB@(2,.2403)="""@""")
- IF (VAPA(2,DFN_",",.2403)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +28 ;SERVICE CONNECTED - .301 - VAPA(2,DFN,.301)
- +29 ;I (@VAFCB@(2,.301)="""@"""),(VAPA(2,DFN_",",.301)]"") S VAFCQ(1)=1 G CHQ
- +30 ;SC% - .302 - VAPA(2,DFN,.302)
- +31 ;I '@VAFCB@(2,.302),VAPA(2,DFN_",",.302) S VAFCQ=1 G CHQ
- +32 ;EMPLOYMENT STATUS - .31115 - VAPA(2,DFN,.31115)
- +33 IF (@VAFCB@(2,.31115)="""@""")
- IF (VAPA(2,DFN_",",.31115)]"")
- SET VAFCQ(1)=1
- GOTO CHQ
- +34 ;PERIOD OF SERVICE - .323 - VAPA(2,DFN,.323)
- +35 ;I (@VAFCB@(2,.323)="""@"""),(VAPA(2,DFN_",",.323)]"") S VAFCQ(1)=1 G CHQ
- +36 ;DATE OF DEATH - .351 - VAPA(2,DFN,.351)
- +37 IF (@VAFCB@(2,.351)="""@""")
- IF VAPA(2,DFN_",",.351)
- SET VAFCQ(1)=1
- GOTO CHQ
- +38 ;PRIMARY ELIG CODE - .361 - VAPA(2,DFN,.361)
- +39 ;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
- +40 ;PATIENT TYPE - 391 - VAPA(2,DFN,391)
- +41 ;I (@VAFCB@(2,391)="""@"""),(VAPA(2,DFN_",",391)]"") S VAFCQ(1)=1 G CHQ
- +42 ;VETERAN (Y/N) - 1901 - VAPA(2,DFN,1901)
- +43 ;I (@VAFCB@(2,1901)="""@"""),VAPA(2,DFN_",",1901) S VAFCQ(1)=1
- CHQ IF $GET(VAFCQ(1))
- DO AVAFC^VAFCDD01(DFN)
- +1 QUIT
- +2 ;
- WHO(X) ; determine the identity of the sending facility, resolve it into
- +1 ; the institution name. Prior to the release of RG*1*8, the sending
- +2 ; facility was passed as the name of the institution. After the
- +3 ; release of RG*1*8, the sending facility is passed in either
- +4 ; format: station # -or- station #~domain. The station # needs
- +5 ; to be resolved into the name of the institution.
- +6 ; called from: ADD^VAFCEHU1 & CHK^VAFCEHU1
- +7 ; INPUT X-string: sending facility (see desc for possible formats)
- +8 if X=""
- QUIT ""
- NEW WHO
- +9 ; passed as station# or station#~domain
- IF $$PATCH^XPDUTL("RG*1.0*8")
- Begin DoDot:1
- +10 ; obtain station #
- SET WHO=+X
- +11 ; from station # to ien
- SET WHO=$$LKUP^XUAF4(WHO)
- +12 ; from ien to name
- SET WHO=$$GET1^DIQ(4,+WHO_",",.01)
- +13 QUIT
- End DoDot:1
- +14 ; before RG*1.0*8, passed as institution name
- IF '$TEST
- SET WHO=X
- +15 QUIT $GET(WHO)
