VAFCMGB3 ;ALB/JRP,LTL,PTD-DEMOGRAPHIC MERGE SCREENS ;07/10/98
;;5.3;Registration;**149,477,479**;Aug 13, 1993
;
;NOTE: This routine contains line tags used to build the display
; screen for a List Manager interface. Refer to routine
; VAFCMGB for a description of input/output variables.
;
GROUP4 ;Line tag to build logical group number four
;
;Group group contains the following fields
; .301, .302, .323, 391, 1901
;
;Column width is limited to 29 characters
;
;Declare variables
N IENS,TARGET,MESSAGE,LINE,DATA,LOCAL,REMOTE,DIFF
S TARGET="^TMP(""VAFC-MERGE-TO"","_$J_",""DATA"")"
S MESSAGE="^TMP(""VAFC-MERGE-TO"","_$J_",""MESSAGE"")"
;Initialize global locations
K @TARGET,@MESSAGE
;Set group index
S @VALMAR@("GRP",4)=VALMCNT
;Get local data for patient
D GETDATA^VAFCMGU0(VAFCDFN,4,TARGET,MESSAGE)
;Build display
S IENS=VAFCDFN_","
;Patient Type
;S LOCAL=$$LOCAL^VAFCMGB0(2,391,IENS,TARGET) ;**477
;S LOCAL=$E(LOCAL,1,29)
;S REMOTE=$$REMOTE^VAFCMGB0(2,391)
;S REMOTE=$E(REMOTE,1,29)
;S DIFF=$$DIFFCHK^VAFCMGB0(2,391,IENS,TARGET)
;S LINE=$S(DIFF:"**",1:" ")
;S:DIFF&($P($G(@VAFCARR@(2,391)),U,2)) LINE="->"
;S DATA="Type: "_LOCAL
;S LINE=$$INSERT^VAFCMGU0(DATA,LINE,11)
;S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
;S @VALMAR@("IDX",VALMCNT,18)=""
;I (DIFF) D
;.S @VALMAR@("E2F",19,1)="2^391"
;.S @VALMAR@("E2G",19)=4
;I ('DIFF) D
;.K @VALMAR@("E2F",19)
;.K @VALMAR@("E2G",19)
;W:(+$G(VAFCDOTS)) "."
;S VALMCNT=VALMCNT+1
;Veteran
S LOCAL=$$LOCAL^VAFCMGB0(2,1901,IENS,TARGET)
S LOCAL=$E(LOCAL,1,29)
S REMOTE=$$REMOTE^VAFCMGB0(2,1901)
S REMOTE=$E(REMOTE,1,29)
S DIFF=$$DIFFCHK^VAFCMGB0(2,1901,IENS,TARGET)
S LINE=$S(DIFF:"**",1:" ")
S:DIFF&($P($G(@VAFCARR@(2,1901)),U,2)) LINE="->"
S DATA="Veteran: "_LOCAL
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,8)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
S (@VALMAR@("IDX",VALMCNT,18),@VALMAR@("IDX",VALMCNT+1,18))=""
;I (DIFF) D
;.S @VALMAR@("E2F",20,1)="2^1901"
;.S @VALMAR@("E2G",20)=4
;I ('DIFF) D
;.K @VALMAR@("E2F",20)
;.K @VALMAR@("E2G",20)
W:(+$G(VAFCDOTS)) "."
S VALMCNT=VALMCNT+1 ;**479 changed +2 to +1
;Service connected and percentage
S LOCAL=$$LOCAL^VAFCMGB0(2,.301,IENS,TARGET)
S LOCAL("SC")=$E(LOCAL,1,29)
S REMOTE=$$REMOTE^VAFCMGB0(2,.301)
S REMOTE("SC")=$E(REMOTE,1,29)
S DIFF=$$DIFFCHK^VAFCMGB0(2,.301,IENS,TARGET)
S LOCAL("SC%")=$$LOCAL^VAFCMGB0(2,.302,IENS,TARGET)
S REMOTE("SC%")=$$REMOTE^VAFCMGB0(2,.302)
S:('DIFF) DIFF=$$DIFFCHK^VAFCMGB0(2,.302,IENS,TARGET)
S:((LOCAL("SC%")="<No Data Found>")&(LOCAL("SC")="NO")) LOCAL("SC%")="N/A"
S:((REMOTE("SC%")="<No Data Found>")&(REMOTE("SC%")="NO")) REMOTE("SC%")="N/A"
S REMOTE("SC")=REMOTE("SC")_" "_REMOTE("SC%")
S LINE=$S(DIFF:"**",1:" ")
S:DIFF&($P($G(@VAFCARR@(2,.301)),U,2)) LINE="->"
S DATA="SC: "_LOCAL("SC")_" SC%: "_LOCAL("SC%")
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,13)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE("SC"),LINE,50)
;S DATA="SC %: "_LOCAL("SC%")
;S LINE=$$INSERT^VAFCMGU0(DATA,"",11)
;S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE("SC%"),LINE,54)
S @VALMAR@("IDX",VALMCNT,18)=""
;S @VALMAR@("IDX",VALMCNT+1,21)=""
;S @VALMAR@("IDX",VALMCNT+2,21)=""
;I (DIFF) D
;.S @VALMAR@("E2F",21,1)="2^.301"
;.S @VALMAR@("E2F",21,2)="2^.302"
;.S @VALMAR@("E2G",21)=4
;I ('DIFF) D
;.K @VALMAR@("E2F",21)
;.K @VALMAR@("E2G",21)
W:(+$G(VAFCDOTS)) "."
S VALMCNT=VALMCNT+1
;Period of service
S LOCAL=$$LOCAL^VAFCMGB0(2,.323,IENS,TARGET)
S LOCAL=$E(LOCAL,1,29)
S REMOTE=$$REMOTE^VAFCMGB0(2,.323)
S REMOTE=$E(REMOTE,1,29)
S DIFF=$$DIFFCHK^VAFCMGB0(2,.323,IENS,TARGET)
S LINE=$S(DIFF:"**",1:" ")
S:DIFF&($P($G(@VAFCARR@(2,.323)),U,2)) LINE="->"
S DATA="POS: "_LOCAL
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,12)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
S @VALMAR@("IDX",VALMCNT,18)=""
;I (DIFF) D
;.S @VALMAR@("E2F",22,1)="2^.323"
;.S @VALMAR@("E2G",22)=4
;I ('DIFF) D
;.K @VALMAR@("E2F",22)
;.K @VALMAR@("E2G",22)
W:(+$G(VAFCDOTS)) "."
S VALMCNT=VALMCNT+1
;Primary Eligibility Code
S LOCAL=$$LOCAL^VAFCMGB0(2,.361,IENS,TARGET)
S REMOTE=$$REMOTE^VAFCMGB0(2,.361)
S DIFF=$$DIFFCHK^VAFCMGB0(2,.361,IENS,TARGET)
S LINE=$S(DIFF:"**",1:" ")
S:DIFF&($P($G(@VAFCARR@(2,.361)),U,2)) LINE="->"
S DATA="Prim Elig Code: "_LOCAL
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
S @VALMAR@("IDX",VALMCNT,18)=""
S VALMCNT=VALMCNT+1
;Date of eligibility status
S LOCAL=$$LOCAL^VAFCMGB0(2,.3612,IENS,TARGET)
S REMOTE=$$FMTE^XLFDT($$REMOTE^VAFCMGB0(2,.3612),1)
S DIFF=$$DIFFCHK^VAFCMGB0(2,.3612,IENS,TARGET)
S LINE=$S(DIFF:"**",1:" ")
S:DIFF&($P($G(@VAFCARR@(2,.3612)),U,2)) LINE="->"
S DATA="Date Verified: "_LOCAL
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
S @VALMAR@("IDX",VALMCNT,18)=""
S VALMCNT=VALMCNT+1
;Verification method
S LOCAL=$$LOCAL^VAFCMGB0(2,.3615,IENS,TARGET)
S REMOTE=$$REMOTE^VAFCMGB0(2,.3615)
S DIFF=$$DIFFCHK^VAFCMGB0(2,.3615,IENS,TARGET)
S LINE=$S(DIFF:"**",1:" ")
S:DIFF&($P($G(@VAFCARR@(2,.3615)),U,2)) LINE="->"
S DATA="Verification method: "
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0("",LINE,50)
S @VALMAR@("IDX",VALMCNT,18)=""
S VALMCNT=VALMCNT+1
S LINE="",LINE=$$INSERT^VAFCMGU0(LOCAL,LINE,3)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
S @VALMAR@("IDX",VALMCNT,18)=""
S VALMCNT=VALMCNT+1
;Who verified locally (no remote data sent)
S LOCAL=$$LOCAL^VAFCMGB0(2,.3616,IENS,TARGET)
S REMOTE="<Not Available>"
S LINE=" "
S DATA="Who verified: "_LOCAL
S LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
S @VALMAR@("IDX",VALMCNT,18)=""
S VALMCNT=VALMCNT+1
;If PATIENT ELIGIBILITIES multiple contains EMPLOYEE, display local data (no remote data sent).
S LOCAL=$O(^DIC(8,"B","EMPLOYEE",0)) I LOCAL D
.Q:'$D(^DPT(VAFCDFN,"E",LOCAL,0))
.;Else patient is an employee
.S REMOTE="<Not Available>",LINE=" ",DATA="Other Eligibility: EMPLOYEE"
.S LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
.S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
.S @VALMAR@("IDX",VALMCNT,18)=""
;Done - cleanup global locations used
K @TARGET,@MESSAGE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCMGB3 6427 printed Sep 23, 2025@20:37:46 Page 2
VAFCMGB3 ;ALB/JRP,LTL,PTD-DEMOGRAPHIC MERGE SCREENS ;07/10/98
+1 ;;5.3;Registration;**149,477,479**;Aug 13, 1993
+2 ;
+3 ;NOTE: This routine contains line tags used to build the display
+4 ; screen for a List Manager interface. Refer to routine
+5 ; VAFCMGB for a description of input/output variables.
+6 ;
GROUP4 ;Line tag to build logical group number four
+1 ;
+2 ;Group group contains the following fields
+3 ; .301, .302, .323, 391, 1901
+4 ;
+5 ;Column width is limited to 29 characters
+6 ;
+7 ;Declare variables
+8 NEW IENS,TARGET,MESSAGE,LINE,DATA,LOCAL,REMOTE,DIFF
+9 SET TARGET="^TMP(""VAFC-MERGE-TO"","_$JOB_",""DATA"")"
+10 SET MESSAGE="^TMP(""VAFC-MERGE-TO"","_$JOB_",""MESSAGE"")"
+11 ;Initialize global locations
+12 KILL @TARGET,@MESSAGE
+13 ;Set group index
+14 SET @VALMAR@("GRP",4)=VALMCNT
+15 ;Get local data for patient
+16 DO GETDATA^VAFCMGU0(VAFCDFN,4,TARGET,MESSAGE)
+17 ;Build display
+18 SET IENS=VAFCDFN_","
+19 ;Patient Type
+20 ;S LOCAL=$$LOCAL^VAFCMGB0(2,391,IENS,TARGET) ;**477
+21 ;S LOCAL=$E(LOCAL,1,29)
+22 ;S REMOTE=$$REMOTE^VAFCMGB0(2,391)
+23 ;S REMOTE=$E(REMOTE,1,29)
+24 ;S DIFF=$$DIFFCHK^VAFCMGB0(2,391,IENS,TARGET)
+25 ;S LINE=$S(DIFF:"**",1:" ")
+26 ;S:DIFF&($P($G(@VAFCARR@(2,391)),U,2)) LINE="->"
+27 ;S DATA="Type: "_LOCAL
+28 ;S LINE=$$INSERT^VAFCMGU0(DATA,LINE,11)
+29 ;S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+30 ;S @VALMAR@("IDX",VALMCNT,18)=""
+31 ;I (DIFF) D
+32 ;.S @VALMAR@("E2F",19,1)="2^391"
+33 ;.S @VALMAR@("E2G",19)=4
+34 ;I ('DIFF) D
+35 ;.K @VALMAR@("E2F",19)
+36 ;.K @VALMAR@("E2G",19)
+37 ;W:(+$G(VAFCDOTS)) "."
+38 ;S VALMCNT=VALMCNT+1
+39 ;Veteran
+40 SET LOCAL=$$LOCAL^VAFCMGB0(2,1901,IENS,TARGET)
+41 SET LOCAL=$EXTRACT(LOCAL,1,29)
+42 SET REMOTE=$$REMOTE^VAFCMGB0(2,1901)
+43 SET REMOTE=$EXTRACT(REMOTE,1,29)
+44 SET DIFF=$$DIFFCHK^VAFCMGB0(2,1901,IENS,TARGET)
+45 SET LINE=$SELECT(DIFF:"**",1:" ")
+46 if DIFF&($PIECE($GET(@VAFCARR@(2,1901)),U,2))
SET LINE="->"
+47 SET DATA="Veteran: "_LOCAL
+48 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,8)
+49 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+50 SET (@VALMAR@("IDX",VALMCNT,18),@VALMAR@("IDX",VALMCNT+1,18))=""
+51 ;I (DIFF) D
+52 ;.S @VALMAR@("E2F",20,1)="2^1901"
+53 ;.S @VALMAR@("E2G",20)=4
+54 ;I ('DIFF) D
+55 ;.K @VALMAR@("E2F",20)
+56 ;.K @VALMAR@("E2G",20)
+57 if (+$GET(VAFCDOTS))
WRITE "."
+58 ;**479 changed +2 to +1
SET VALMCNT=VALMCNT+1
+59 ;Service connected and percentage
+60 SET LOCAL=$$LOCAL^VAFCMGB0(2,.301,IENS,TARGET)
+61 SET LOCAL("SC")=$EXTRACT(LOCAL,1,29)
+62 SET REMOTE=$$REMOTE^VAFCMGB0(2,.301)
+63 SET REMOTE("SC")=$EXTRACT(REMOTE,1,29)
+64 SET DIFF=$$DIFFCHK^VAFCMGB0(2,.301,IENS,TARGET)
+65 SET LOCAL("SC%")=$$LOCAL^VAFCMGB0(2,.302,IENS,TARGET)
+66 SET REMOTE("SC%")=$$REMOTE^VAFCMGB0(2,.302)
+67 if ('DIFF)
SET DIFF=$$DIFFCHK^VAFCMGB0(2,.302,IENS,TARGET)
+68 if ((LOCAL("SC%")="<No Data Found>")&(LOCAL("SC")="NO"))
SET LOCAL("SC%")="N/A"
+69 if ((REMOTE("SC%")="<No Data Found>")&(REMOTE("SC%")="NO"))
SET REMOTE("SC%")="N/A"
+70 SET REMOTE("SC")=REMOTE("SC")_" "_REMOTE("SC%")
+71 SET LINE=$SELECT(DIFF:"**",1:" ")
+72 if DIFF&($PIECE($GET(@VAFCARR@(2,.301)),U,2))
SET LINE="->"
+73 SET DATA="SC: "_LOCAL("SC")_" SC%: "_LOCAL("SC%")
+74 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,13)
+75 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE("SC"),LINE,50)
+76 ;S DATA="SC %: "_LOCAL("SC%")
+77 ;S LINE=$$INSERT^VAFCMGU0(DATA,"",11)
+78 ;S @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE("SC%"),LINE,54)
+79 SET @VALMAR@("IDX",VALMCNT,18)=""
+80 ;S @VALMAR@("IDX",VALMCNT+1,21)=""
+81 ;S @VALMAR@("IDX",VALMCNT+2,21)=""
+82 ;I (DIFF) D
+83 ;.S @VALMAR@("E2F",21,1)="2^.301"
+84 ;.S @VALMAR@("E2F",21,2)="2^.302"
+85 ;.S @VALMAR@("E2G",21)=4
+86 ;I ('DIFF) D
+87 ;.K @VALMAR@("E2F",21)
+88 ;.K @VALMAR@("E2G",21)
+89 if (+$GET(VAFCDOTS))
WRITE "."
+90 SET VALMCNT=VALMCNT+1
+91 ;Period of service
+92 SET LOCAL=$$LOCAL^VAFCMGB0(2,.323,IENS,TARGET)
+93 SET LOCAL=$EXTRACT(LOCAL,1,29)
+94 SET REMOTE=$$REMOTE^VAFCMGB0(2,.323)
+95 SET REMOTE=$EXTRACT(REMOTE,1,29)
+96 SET DIFF=$$DIFFCHK^VAFCMGB0(2,.323,IENS,TARGET)
+97 SET LINE=$SELECT(DIFF:"**",1:" ")
+98 if DIFF&($PIECE($GET(@VAFCARR@(2,.323)),U,2))
SET LINE="->"
+99 SET DATA="POS: "_LOCAL
+100 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,12)
+101 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+102 SET @VALMAR@("IDX",VALMCNT,18)=""
+103 ;I (DIFF) D
+104 ;.S @VALMAR@("E2F",22,1)="2^.323"
+105 ;.S @VALMAR@("E2G",22)=4
+106 ;I ('DIFF) D
+107 ;.K @VALMAR@("E2F",22)
+108 ;.K @VALMAR@("E2G",22)
+109 if (+$GET(VAFCDOTS))
WRITE "."
+110 SET VALMCNT=VALMCNT+1
+111 ;Primary Eligibility Code
+112 SET LOCAL=$$LOCAL^VAFCMGB0(2,.361,IENS,TARGET)
+113 SET REMOTE=$$REMOTE^VAFCMGB0(2,.361)
+114 SET DIFF=$$DIFFCHK^VAFCMGB0(2,.361,IENS,TARGET)
+115 SET LINE=$SELECT(DIFF:"**",1:" ")
+116 if DIFF&($PIECE($GET(@VAFCARR@(2,.361)),U,2))
SET LINE="->"
+117 SET DATA="Prim Elig Code: "_LOCAL
+118 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
+119 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+120 SET @VALMAR@("IDX",VALMCNT,18)=""
+121 SET VALMCNT=VALMCNT+1
+122 ;Date of eligibility status
+123 SET LOCAL=$$LOCAL^VAFCMGB0(2,.3612,IENS,TARGET)
+124 SET REMOTE=$$FMTE^XLFDT($$REMOTE^VAFCMGB0(2,.3612),1)
+125 SET DIFF=$$DIFFCHK^VAFCMGB0(2,.3612,IENS,TARGET)
+126 SET LINE=$SELECT(DIFF:"**",1:" ")
+127 if DIFF&($PIECE($GET(@VAFCARR@(2,.3612)),U,2))
SET LINE="->"
+128 SET DATA="Date Verified: "_LOCAL
+129 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
+130 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+131 SET @VALMAR@("IDX",VALMCNT,18)=""
+132 SET VALMCNT=VALMCNT+1
+133 ;Verification method
+134 SET LOCAL=$$LOCAL^VAFCMGB0(2,.3615,IENS,TARGET)
+135 SET REMOTE=$$REMOTE^VAFCMGB0(2,.3615)
+136 SET DIFF=$$DIFFCHK^VAFCMGB0(2,.3615,IENS,TARGET)
+137 SET LINE=$SELECT(DIFF:"**",1:" ")
+138 if DIFF&($PIECE($GET(@VAFCARR@(2,.3615)),U,2))
SET LINE="->"
+139 SET DATA="Verification method: "
+140 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
+141 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0("",LINE,50)
+142 SET @VALMAR@("IDX",VALMCNT,18)=""
+143 SET VALMCNT=VALMCNT+1
+144 SET LINE=""
SET LINE=$$INSERT^VAFCMGU0(LOCAL,LINE,3)
+145 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+146 SET @VALMAR@("IDX",VALMCNT,18)=""
+147 SET VALMCNT=VALMCNT+1
+148 ;Who verified locally (no remote data sent)
+149 SET LOCAL=$$LOCAL^VAFCMGB0(2,.3616,IENS,TARGET)
+150 SET REMOTE="<Not Available>"
+151 SET LINE=" "
+152 SET DATA="Who verified: "_LOCAL
+153 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
+154 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+155 SET @VALMAR@("IDX",VALMCNT,18)=""
+156 SET VALMCNT=VALMCNT+1
+157 ;If PATIENT ELIGIBILITIES multiple contains EMPLOYEE, display local data (no remote data sent).
+158 SET LOCAL=$ORDER(^DIC(8,"B","EMPLOYEE",0))
IF LOCAL
Begin DoDot:1
+159 if '$DATA(^DPT(VAFCDFN,"E",LOCAL,0))
QUIT
+160 ;Else patient is an employee
+161 SET REMOTE="<Not Available>"
SET LINE=" "
SET DATA="Other Eligibility: EMPLOYEE"
+162 SET LINE=$$INSERT^VAFCMGU0(DATA,LINE,3)
+163 SET @VALMAR@(VALMCNT,0)=$$INSERT^VAFCMGU0(REMOTE,LINE,50)
+164 SET @VALMAR@("IDX",VALMCNT,18)=""
End DoDot:1
+165 ;Done - cleanup global locations used
+166 KILL @TARGET,@MESSAGE
+167 QUIT
