VAFCTR ;BIR/CMC,ERC,PTD-Monitoring fields for MPI/PD via DG field monitoring ; 1/31/17 11:04am
;;5.3;Registration;**575,648,653,712,876,902,926,937,944,967,1059,1071**;Aug 13, 1993;Build 4
Q ; quit if called from the top
;
MPIPD ; protocol entry point for monitoring fields via DG field monitoring
; Currently monitoring for fields:
; 1 ALIAS - .01 of the multiple
; 2 RACE INFORMATION - .01 of the multiple
; 6 ETHNICITY INFORMATION - .01 of the multiple
; 994 MULTIPLE BIRTH INDICATOR
; .525 POW STAUTS INDICATED?
; .0906 PSEUDO SSN REASON
; .121 BAD ADDRESS INDICATOR
; .133 EMAIL ADDRESS
; .134 PHONE NUMBER [CELLULAR]
; .024 SELF IDENTIFIED GENDER **876
; 391 TYPE ;**876
; 1901 VETERAN Y/N? **876
; .323 PERIOD OF SERVICE **876
; .352 DEATH ENTERED BY **902 MVI_4735 (jfw)
; .353 SOURCE OF NOTIFICATION **902 MVI_4735 (jfw)
; .354 DATE OF DEATH LAST UPDATED **902 MVI_4735 (jfw)
; .355 LAST EDITED BY **902 MVI_4735 (jfw)
; .357 SUPPORTING DOCUMENT TYPE **926 STORY 323008 (jfw)
; .2405 PREFERRED NAME **937 STORY 445457 [Sub-Story 455414] (jfw)
; .0931 PLACE OF BIRTH COUNTRY **944 STORY 504382 [Sub-Story 513042] (jfw)
; .0932 PLACE OF BIRTH PROVINCE **944 STORY 504382 [Sub-Story 513042] (jfw)
;
;**967 STORY #783361 Sensitivity (jfw)
; DG SECURITY LOG File #38.1 monitored field:
; Note: .01 is DINUMED to the PATIENT File #2
; 2 SECURITY LEVEL
;
;**1059 STORY VAMPI-11114, VAMPI-11118, VAMPI-11120, VAMPI-11121 (jfw)
; .025 SEXUAL ORIENTATION - .01 of the multiple
;**1071 STORY VAMPI-13755 (jfw) - Additional SO Fields in multiple
; .02 STATUS
; .03 DATE CREATED
; .04 DATE LAST UPDATED
; .2406 PRONOUN - .01 of the multiple
; .0251 SEXUAL ORIENTATION DESCRIPTION
; .1151 RESIDENTIAL ADDRESS [LINE 1]
; .1152 RESIDENTIAL ADDRESS [LINE 2]
; .1153 RESIDENTIAL ADDRESS [LINE 3]
; .1154 RESIDENTIAL CITY
; .1155 RESIDENTIAL STATE
; .1156 RESIDENTIAL ZIP+4
; .11571 RESIDENTIAL PROVINCE
; .11572 RESIDENTIAL POSTAL CODE
; .11573 RESIDENTIAL COUNTRY
; .24061 PRONOUN DESCRIPTION
; 991.11 INDIVIDUAL TAX ID
;
N MVIRSLT
I $G(DGFILE)'=2&($G(DGFILE)'=2.01)&($G(DGFILE)'=2.02)&($G(DGFILE)'=2.06)&($G(DGFILE)'=38.1)&($G(DGFILE)'=2.025)&($G(DGFILE)'=2.2406) Q
S DGFIELD=$G(DGFIELD)
;I DGFIELD'=.01&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133)&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) Q
;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above)
S MVIRSLT=(DGFIELD'=.01)&(DGFIELD'=.02)&(DGFIELD'=.03)&(DGFIELD'=.04)&(DGFIELD'=994)&(DGFIELD'=.525)
S MVIRSLT=MVIRSLT&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133)
S MVIRSLT=MVIRSLT&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024)
S MVIRSLT=MVIRSLT&(DGFIELD'=.352)&(DGFIELD'=.353)&(DGFIELD'=.354)&(DGFIELD'=.355)&(DGFIELD'=.357)
S MVIRSLT=MVIRSLT&(DGFIELD'=.2405)&(DGFIELD'=.0931)&(DGFIELD'=.0932)&(DGFIELD'=2)&(DGFIELD'=.0251)
S MVIRSLT=MVIRSLT&(DGFIELD'=.1151)&(DGFIELD'=.1152)&(DGFIELD'=.1153)&(DGFIELD'=.1154)&(DGFIELD'=.1155)
S MVIRSLT=MVIRSLT&(DGFIELD'=.1156)&(DGFIELD'=.11571)&(DGFIELD'=.11572)&(DGFIELD'=.11573)&(DGFIELD'=.24061)
S MVIRSLT=MVIRSLT&(DGFIELD'=991.11)
Q:(MVIRSLT)
I $T(AVAFC^VAFCDD01)="" Q
;The fields below are not multiples
;I (DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA)
;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above)
S MVIRSLT=(DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)
S MVIRSLT=MVIRSLT!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323)
S MVIRSLT=MVIRSLT!(DGFIELD=.352)!(DGFIELD=.353)!(DGFIELD=.354)!(DGFIELD=.355)!(DGFIELD=.357)
S MVIRSLT=MVIRSLT!(DGFIELD=.2405)!(DGFIELD=.0931)!(DGFIELD=.0932)!(DGFIELD=.0251)!(DGFIELD=.1151)
S MVIRSLT=MVIRSLT!(DGFIELD=.1152)!(DGFIELD=.1153)!(DGFIELD=.1154)!(DGFIELD=.1155)!(DGFIELD=.1156)
S MVIRSLT=MVIRSLT!(DGFIELD=.11571)!(DGFIELD=.11572)!(DGFIELD=.11573)!(DGFIELD=.24061)!(DGFIELD=991.11)
I MVIRSLT S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA)
;The fields below ARE multiples
I DGFILE=2.01 S VAFCF="1;" D AVAFC^VAFCDD01(DGDA(1)) ;ALIAS
I DGFILE=2.02 S VAFCF="2.02,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;RACE INFORMATION
I DGFILE=2.06 S VAFCF="2.06,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;ETHNICITY INFORMATION
I DGFILE=2.025 S VAFCF="2.025,"_DGFIELD_";" D AVAFC^VAFCDD01(DGDA(1)) ;SEXUAL ORIENTATION
I DGFILE=2.2406 S VAFCF="2.2406,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;PRONOUN
;Process field for different File **967 (jfw)
I DGFILE=38.1 S VAFCF="38.1,2;" D AVAFC^VAFCDD01(DGDA) ;Sensitivity Info
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCTR 4918 printed Sep 23, 2025@20:38:27 Page 2
VAFCTR ;BIR/CMC,ERC,PTD-Monitoring fields for MPI/PD via DG field monitoring ; 1/31/17 11:04am
+1 ;;5.3;Registration;**575,648,653,712,876,902,926,937,944,967,1059,1071**;Aug 13, 1993;Build 4
+2 ; quit if called from the top
QUIT
+3 ;
MPIPD ; protocol entry point for monitoring fields via DG field monitoring
+1 ; Currently monitoring for fields:
+2 ; 1 ALIAS - .01 of the multiple
+3 ; 2 RACE INFORMATION - .01 of the multiple
+4 ; 6 ETHNICITY INFORMATION - .01 of the multiple
+5 ; 994 MULTIPLE BIRTH INDICATOR
+6 ; .525 POW STAUTS INDICATED?
+7 ; .0906 PSEUDO SSN REASON
+8 ; .121 BAD ADDRESS INDICATOR
+9 ; .133 EMAIL ADDRESS
+10 ; .134 PHONE NUMBER [CELLULAR]
+11 ; .024 SELF IDENTIFIED GENDER **876
+12 ; 391 TYPE ;**876
+13 ; 1901 VETERAN Y/N? **876
+14 ; .323 PERIOD OF SERVICE **876
+15 ; .352 DEATH ENTERED BY **902 MVI_4735 (jfw)
+16 ; .353 SOURCE OF NOTIFICATION **902 MVI_4735 (jfw)
+17 ; .354 DATE OF DEATH LAST UPDATED **902 MVI_4735 (jfw)
+18 ; .355 LAST EDITED BY **902 MVI_4735 (jfw)
+19 ; .357 SUPPORTING DOCUMENT TYPE **926 STORY 323008 (jfw)
+20 ; .2405 PREFERRED NAME **937 STORY 445457 [Sub-Story 455414] (jfw)
+21 ; .0931 PLACE OF BIRTH COUNTRY **944 STORY 504382 [Sub-Story 513042] (jfw)
+22 ; .0932 PLACE OF BIRTH PROVINCE **944 STORY 504382 [Sub-Story 513042] (jfw)
+23 ;
+24 ;**967 STORY #783361 Sensitivity (jfw)
+25 ; DG SECURITY LOG File #38.1 monitored field:
+26 ; Note: .01 is DINUMED to the PATIENT File #2
+27 ; 2 SECURITY LEVEL
+28 ;
+29 ;**1059 STORY VAMPI-11114, VAMPI-11118, VAMPI-11120, VAMPI-11121 (jfw)
+30 ; .025 SEXUAL ORIENTATION - .01 of the multiple
+31 ;**1071 STORY VAMPI-13755 (jfw) - Additional SO Fields in multiple
+32 ; .02 STATUS
+33 ; .03 DATE CREATED
+34 ; .04 DATE LAST UPDATED
+35 ; .2406 PRONOUN - .01 of the multiple
+36 ; .0251 SEXUAL ORIENTATION DESCRIPTION
+37 ; .1151 RESIDENTIAL ADDRESS [LINE 1]
+38 ; .1152 RESIDENTIAL ADDRESS [LINE 2]
+39 ; .1153 RESIDENTIAL ADDRESS [LINE 3]
+40 ; .1154 RESIDENTIAL CITY
+41 ; .1155 RESIDENTIAL STATE
+42 ; .1156 RESIDENTIAL ZIP+4
+43 ; .11571 RESIDENTIAL PROVINCE
+44 ; .11572 RESIDENTIAL POSTAL CODE
+45 ; .11573 RESIDENTIAL COUNTRY
+46 ; .24061 PRONOUN DESCRIPTION
+47 ; 991.11 INDIVIDUAL TAX ID
+48 ;
+49 NEW MVIRSLT
+50 IF $GET(DGFILE)'=2&($GET(DGFILE)'=2.01)&($GET(DGFILE)'=2.02)&($GET(DGFILE)'=2.06)&($GET(DGFILE)'=38.1)&($GET(DGFILE)'=2.025)&($GET(DGFILE)'=2.2406)
QUIT
+51 SET DGFIELD=$GET(DGFIELD)
+52 ;I DGFIELD'=.01&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133)&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) Q
+53 ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above)
+54 SET MVIRSLT=(DGFIELD'=.01)&(DGFIELD'=.02)&(DGFIELD'=.03)&(DGFIELD'=.04)&(DGFIELD'=994)&(DGFIELD'=.525)
+55 SET MVIRSLT=MVIRSLT&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133)
+56 SET MVIRSLT=MVIRSLT&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024)
+57 SET MVIRSLT=MVIRSLT&(DGFIELD'=.352)&(DGFIELD'=.353)&(DGFIELD'=.354)&(DGFIELD'=.355)&(DGFIELD'=.357)
+58 SET MVIRSLT=MVIRSLT&(DGFIELD'=.2405)&(DGFIELD'=.0931)&(DGFIELD'=.0932)&(DGFIELD'=2)&(DGFIELD'=.0251)
+59 SET MVIRSLT=MVIRSLT&(DGFIELD'=.1151)&(DGFIELD'=.1152)&(DGFIELD'=.1153)&(DGFIELD'=.1154)&(DGFIELD'=.1155)
+60 SET MVIRSLT=MVIRSLT&(DGFIELD'=.1156)&(DGFIELD'=.11571)&(DGFIELD'=.11572)&(DGFIELD'=.11573)&(DGFIELD'=.24061)
+61 SET MVIRSLT=MVIRSLT&(DGFIELD'=991.11)
+62 if (MVIRSLT)
QUIT
+63 IF $TEXT(AVAFC^VAFCDD01)=""
QUIT
+64 ;The fields below are not multiples
+65 ;I (DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA)
+66 ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above)
+67 SET MVIRSLT=(DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)
+68 SET MVIRSLT=MVIRSLT!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323)
+69 SET MVIRSLT=MVIRSLT!(DGFIELD=.352)!(DGFIELD=.353)!(DGFIELD=.354)!(DGFIELD=.355)!(DGFIELD=.357)
+70 SET MVIRSLT=MVIRSLT!(DGFIELD=.2405)!(DGFIELD=.0931)!(DGFIELD=.0932)!(DGFIELD=.0251)!(DGFIELD=.1151)
+71 SET MVIRSLT=MVIRSLT!(DGFIELD=.1152)!(DGFIELD=.1153)!(DGFIELD=.1154)!(DGFIELD=.1155)!(DGFIELD=.1156)
+72 SET MVIRSLT=MVIRSLT!(DGFIELD=.11571)!(DGFIELD=.11572)!(DGFIELD=.11573)!(DGFIELD=.24061)!(DGFIELD=991.11)
+73 IF MVIRSLT
SET VAFCF=DGFIELD_";"
DO AVAFC^VAFCDD01(DGDA)
+74 ;The fields below ARE multiples
+75 ;ALIAS
IF DGFILE=2.01
SET VAFCF="1;"
DO AVAFC^VAFCDD01(DGDA(1))
+76 ;RACE INFORMATION
IF DGFILE=2.02
SET VAFCF="2.02,.01;"
DO AVAFC^VAFCDD01(DGDA(1))
+77 ;ETHNICITY INFORMATION
IF DGFILE=2.06
SET VAFCF="2.06,.01;"
DO AVAFC^VAFCDD01(DGDA(1))
+78 ;SEXUAL ORIENTATION
IF DGFILE=2.025
SET VAFCF="2.025,"_DGFIELD_";"
DO AVAFC^VAFCDD01(DGDA(1))
+79 ;PRONOUN
IF DGFILE=2.2406
SET VAFCF="2.2406,.01;"
DO AVAFC^VAFCDD01(DGDA(1))
+80 ;Process field for different File **967 (jfw)
+81 ;Sensitivity Info
IF DGFILE=38.1
SET VAFCF="38.1,2;"
DO AVAFC^VAFCDD01(DGDA)
+82 QUIT
