DG53754P.m

DG53754P ;ALB/TDM - Patch DG*5.3*754 Install Utility Routine ; 7/22/10 10:58am

 ;;5.3;Registration;**754**;AUG 13, 1993;Build 46

 Q

EP ;Entry point - Driver

 N ABORT,FILE,I,ELEMNT,EXIST,DGDATA,DATA,SUB,J,VALUE,FILEFLG

 ;

 D START^DG53754A    ;Run field definition clean-up per EVC_CR9102

 ;

 S (ABORT,FILEFLG)=0,FILE=301.92

 F I=1:1 S ELEMNT=$P($T(TEXT+I),";;",2) Q:ELEMNT="QUIT"!(ABORT)  D

 . S EXIST=0

 . K DGDATA S (DATA,SUB)="" F J=1:1:$L(ELEMNT,";") S DATA=$P(ELEMNT,";",J) D  Q:EXIST

 . . S SUB=$P(DATA,"~",1),VALUE=$P(DATA,"~",2),DGDATA(SUB)=VALUE

 . . I SUB=.01 S EXIST=$$FIND1^DIC(FILE,,,DGDATA(.01))

 . I 'EXIST D

 . . S FILEFLG=$$ADD^DGENDBS(FILE,,.DGDATA)

 . . I FILEFLG D MES^XPDUTL("Added - "_$G(DGDATA(.01)))

 . . I 'FILEFLG D

 . . . S ABORT=1,XPDABORT=2

 . . . D BMES^XPDUTL("Install process could not add an entry in file for "_$G(DGDATA(.01)))

 . . . D BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

 I 'ABORT D EP^DG53754C  ;Continuation due to routine size limit

 I 'ABORT D BMES^XPDUTL("<<<< Post Install Successful >>>>")

 Q

 ;

TEXT ;;FIELD#~VALUE;FIELD#~VALUE;FIELD#~VALUE.....

 ;;.01~MOTHER'S MAIDEN NAME;.02~PID06;.03~1;.04~2;.05~.2403;.08~0;10~S DR=.2403 D LOOK^IVMPREC9;20~S DR=.2403 D LOOK^IVMPREC9

 ;;.01~RACE;.02~PID10;.03~1;.04~2;.05~2;.08~0;10~S Y=$P(VADM(12),"^");20~S Y=$P(VADM(12),"^",2)

 ;;.01~MARITAL STATUS;.02~PID16;.03~1;.04~2;.05~.05;.06~1;.08~0;10~S Y=$P(VADM(10),"^");20~S Y=$P(VADM(10),"^",2)

 ;;.01~RELIGION;.02~PID17;.03~1;.04~2;.05~.08;.06~1;.08~0;10~S Y=$P(VADM(9),"^");20~S Y=$P(VADM(9),"^",2)

 ;;.01~ETHNICITY;.02~PID22;.03~1;.04~2;.05~6;.06~1;.08~0;10~S Y=$P($G(VADM(11,1)),"^");20~S Y=$P($G(VADM(11,1)),"^",2)

 ;;.01~SPINAL CORD INJURY;.02~ZPD30;.03~0;.04~2;.05~57.4;.08~0;10~S DR=57.4 D LOOK^IVMPREC9;20~S DR=57.4,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~PSEUDO SSN REASON;.02~ZPD34;.03~1;.04~2;.05~.0906;.08~0;10~S DR=.0906 D LOOK^IVMPREC9;20~S DR=.0906,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS ACTIVE;.02~ZTA02;.03~1;.04~2;.05~.12105;.08~0;10~S DR=.12105 D LOOK^IVMPREC9;20~S DR=.12105 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS BEGIN DATE;.02~ZTA03;.03~1;.04~2;.05~.1217;.06~1;.08~0;10~S DR=.1217 D LOOK^IVMPREC9;20~S DR=.1217,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS END DATE;.02~ZTA04;.03~1;.04~2;.05~.1218;.06~1;.08~0;10~S DR=.1218 D LOOK^IVMPREC9;20~S DR=.1218,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS [LINE] 1;.02~ZTA051;.03~1;.04~2;.05~.1211;.08~0;10~S DR=.1211 D LOOK^IVMPREC9;20~S DR=.1211 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS [LINE] 2;.02~ZTA052;.03~1;.04~2;.05~.1212;.08~0;10~S DR=.1212 D LOOK^IVMPREC9;20~S DR=.1212 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS [LINE] 3;.02~ZTA058;.03~1;.04~2;.05~.1213;.08~0;10~S DR=.1213 D LOOK^IVMPREC9;20~S DR=.1213 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS CITY;.02~ZTA053;.03~1;.04~2;.05~.1214;.08~0;10~S DR=.1214 D LOOK^IVMPREC9;20~S DR=.1214 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS STATE;.02~ZTA054;.03~1;.04~2;.05~.1215;.06~1;.08~0;10~S DR=.1215 D LOOK^IVMPREC9;20~S DR=.1215,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS ZIP;.02~ZTA055;.03~1;.04~2;.05~.1216;.08~0;10~S DR=.1216 D LOOK^IVMPREC9;S DR=.1216 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS COUNTRY;.02~ZTA056;.03~1;.04~2;.05~.1223;.06~1;.08~0;10~S DR=.1223 D LOOK^IVMPREC9;S DR=.1223,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS COUNTY;.02~ZTA059;.03~1;.04~2;.05~.12111;.06~1;.08~0;10~S DR=.12111 D LOOK^IVMPREC9;S DR=.12111 D LOOK^IVMPREC9

 ;;.01~TEMPORARY ADDRESS PROVINCE;.02~ZTA054F;.03~1;.04~2;.05~.1221;.08~0;10~S DR=.1221 D LOOK^IVMPREC9;20~S DR=.1221 D LOOK^IVMPREC9"

 ;;.01~TEMPORARY ADDRESS POSTAL CODE;.02~ZTA055F;.03~1;.04~2;.05~.1222;.08~0;10~S DR=.1222 D LOOK^IVMPREC9;20~S DR=.1222 D LOOK^IVMPREC9"

 ;;.01~TEMPORARY ADDRESS TELEPHONE;.02~ZTA07;.03~1;.04~2;.05~.1219;.08~0;10~S DR=.1219 D LOOK^IVMPREC9;20~S DR=.1219 D LOOK^IVMPREC9

 ;;.01~TEMP ADDR LAST UPDATED DT/TM;.02~ZTA08;.03~1;.04~2;.05~.12113;.06~1;.08~0;10~S DR=.12113 D LOOK^IVMPREC9;20~S DR=.12113,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~TEMP ADDR LAST UPDATED SITE;.02~ZTA09;.03~1;.04~2;.05~.12114;.06~1;.08~0;10~S DR=.12114 D LOOK^IVMPREC9;20~S DR=.12114 D LOOK^IVMPREC9

 ;;.01~E-NAME;.02~ZCT03E1;.03~1;.04~2;.05~.331;.08~0;10~S DR=.331 D LOOK^IVMPREC9;20~S DR=.331 D LOOK^IVMPREC9

 ;;.01~E-RELATIONSHIP TO PATIENT;.02~ZCT04E1;.03~1;.04~2;.05~.332;.08~0;10~S DR=.332 D LOOK^IVMPREC9;20~S DR=.332 D LOOK^IVMPREC9

 ;;.01~E-STREET ADDRESS [LINE 1];.02~ZCT051E1;.03~1;.04~2;.05~.333;.08~0;10~S DR=.333 D LOOK^IVMPREC9;20~S DR=.333 D LOOK^IVMPREC9

 ;;.01~E-STREET ADDRESS [LINE 2];.02~ZCT052E1;.03~1;.04~2;.05~.334;.08~0;10~S DR=.334 D LOOK^IVMPREC9;20~S DR=.334 D LOOK^IVMPREC9

 ;;.01~E-CITY;.02~ZCT053E1;.03~1;.04~2;.05~.336;.08~0;10~S DR=.336 D LOOK^IVMPREC9;20~S DR=.336 D LOOK^IVMPREC9

 ;;.01~E-STATE;.02~ZCT054E1;.03~1;.04~2;.05~.337;.06~1;.08~0;10~S DR=.337 D LOOK^IVMPREC9;20~S DR=.337,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~E-ZIP CODE;.02~ZCT055E1;.03~1;.04~2;.05~.338;.08~0;10~S DR=.338 D LOOK^IVMPREC9;20~S DR=.338 D LOOK^IVMPREC9

 ;;.01~E-PHONE NUMBER;.02~ZCT06E1;.03~1;.04~2;.05~.339;.08~0;10~S DR=.339 D LOOK^IVMPREC9;20~S DR=.339 D LOOK^IVMPREC9

 ;;.01~E-WORK PHONE NUMBER;.02~ZCT07E1;.03~1;.04~2;.05~.33011;.08~0;10~S DR=.33011 D LOOK^IVMPREC9;20~S DR=.33011 D LOOK^IVMPREC9

 ;;.01~E-CONTACT CHANGE DATE/TIME;.02~ZCT10E1;.03~1;.04~2;.05~.33012;.06~1;.08~0;10~S DR=.33012 D LOOK^IVMPREC9;20~S DR=.33012,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~E2-NAME OF SECONDARY CONTACT;.02~ZCT03E2;.03~1;.04~2;.05~.3311;.08~0;10~S DR=.3311 D LOOK^IVMPREC9;20~S DR=.3311 D LOOK^IVMPREC9

 ;;.01~E2-RELATIONSHIP TO PATIENT;.02~ZCT04E2;.03~1;.04~2;.05~.3312;.08~0;10~S DR=.3312 D LOOK^IVMPREC9;20~S DR=.3312 D LOOK^IVMPREC9

 ;;.01~E2-STREET ADDRESS [LINE 1];.02~ZCT051E2;.03~1;.04~2;.05~.3313;.08~0;10~S DR=.3313 D LOOK^IVMPREC9;20~S DR=.3313 D LOOK^IVMPREC9

 ;;.01~E2-STREET ADDRESS [LINE 2];.02~ZCT052E2;.03~1;.04~2;.05~.3314;.08~0;10~S DR=.3314 D LOOK^IVMPREC9;20~S DR=.3314 D LOOK^IVMPREC9

 ;;.01~E2-CITY;.02~ZCT053E2;.03~1;.04~2;.05~.3316;.08~0;10~S DR=.3316 D LOOK^IVMPREC9;20~S DR=.3316 D LOOK^IVMPREC9

 ;;.01~E2-STATE;.02~ZCT054E2;.03~1;.04~2;.05~.3317;.06~1;.08~0;10~S DR=.3317 D LOOK^IVMPREC9;20~S DR=.3317,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~E2-ZIP CODE;.02~ZCT055E2;.03~1;.04~2;.05~.3318;.08~0;10~S DR=.3318 D LOOK^IVMPREC9;20~S DR=.3318 D LOOK^IVMPREC9

 ;;.01~E2-PHONE NUMBER;.02~ZCT06E2;.03~1;.04~2;.05~.3319;.08~0;10~S DR=.3319 D LOOK^IVMPREC9;20~S DR=.3319 D LOOK^IVMPREC9

 ;;.01~E2-WORK PHONE NUMBER;.02~ZCT07E2;.03~1;.04~2;.05~.331011;.08~0;10~S DR=.331011 D LOOK^IVMPREC9;20~S DR=.331011 D LOOK^IVMPREC9

 ;;.01~E2-CONTACT CHANGE DATE/TIME;.02~ZCT10E2;.03~1;.04~2;.05~.33112;.06~1;.08~0;10~S DR=.33112 D LOOK^IVMPREC9;20~S DR=.33112,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~K-NAME OF PRIMARY NOK;.02~ZCT03K1;.03~1;.04~2;.05~.211;.08~0;10~S DR=.211 D LOOK^IVMPREC9;20~S DR=.211 D LOOK^IVMPREC9

 ;;.01~K-RELATIONSHIP TO PATIENT;.02~ZCT04K1;.03~1;.04~2;.05~.212;.08~0;10~S DR=.212 D LOOK^IVMPREC9;20~S DR=.212 D LOOK^IVMPREC9

 ;;.01~K-STREET ADDRESS [LINE 1];.02~ZCT051K1;.03~1;.04~2;.05~.213;.08~0;10~S DR=.213 D LOOK^IVMPREC9;20~S DR=.213 D LOOK^IVMPREC9

 ;;.01~K-STREET ADDRESS [LINE 2];.02~ZCT052K1;.03~1;.04~2;.05~.214;.08~0;10~S DR=.214 D LOOK^IVMPREC9;20~S DR=.214 D LOOK^IVMPREC9

 ;;.01~K-CITY;.02~ZCT053K1;.03~1;.04~2;.05~.216;.08~0;10~S DR=.216 D LOOK^IVMPREC9;20~S DR=.216 D LOOK^IVMPREC9

 ;;.01~K-STATE;.02~ZCT054K1;.03~1;.04~2;.05~.217;.06~1;.08~0;10~S DR=.217 D LOOK^IVMPREC9;20~S DR=.217,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~K-ZIP CODE;.02~ZCT055K1;.03~1;.04~2;.05~.218;.08~0;10~S DR=.218 D LOOK^IVMPREC9;20~S DR=.218 D LOOK^IVMPREC9

 ;;.01~K-PHONE NUMBER;.02~ZCT06K1;.03~1;.04~2;.05~.219;.08~0;10~S DR=.219 D LOOK^IVMPREC9;20~S DR=.219 D LOOK^IVMPREC9

 ;;.01~K-WORK PHONE NUMBER;.02~ZCT07K1;.03~1;.04~2;.05~.21011;.08~0;10~S DR=.21011 D LOOK^IVMPREC9;20~S DR=.21011 D LOOK^IVMPREC9

 ;;.01~PRIMARY NOK CHANGE DATE/TIME;.02~ZCT10K1;.03~1;.04~2;.05~.21012;.06~1;.08~0;10~S DR=.21012 D LOOK^IVMPREC9;20~S DR=.21012,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~K2-NAME OF SECONDARY NOK;.02~ZCT03K2;.03~1;.04~2;.05~.2191;.08~0;10~S DR=.2191 D LOOK^IVMPREC9;20~S DR=.2191 D LOOK^IVMPREC9

 ;;.01~K2-RELATIONSHIP TO PATIENT;.02~ZCT04K2;.03~1;.04~2;.05~.2192;.08~0;10~S DR=.2192 D LOOK^IVMPREC9;20~S DR=.2192 D LOOK^IVMPREC9

 ;;.01~K2-STREET ADDRESS [LINE 1];.02~ZCT051K2;.03~1;.04~2;.05~.2193;.08~0;10~S DR=.2193 D LOOK^IVMPREC9;20~S DR=.2193 D LOOK^IVMPREC9

 ;;.01~K2-STREET ADDRESS [LINE 2];.02~ZCT052K2;.03~1;.04~2;.05~.2194;.08~0;10~S DR=.2194 D LOOK^IVMPREC9;20~S DR=.2194 D LOOK^IVMPREC9

 ;;.01~K2-CITY;.02~ZCT053K2;.03~1;.04~2;.05~.2196;.08~0;10~S DR=.2196 D LOOK^IVMPREC9;20~S DR=.2196 D LOOK^IVMPREC9

 ;;.01~K2-STATE;.02~ZCT054K2;.03~1;.04~2;.05~.2197;.06~1;.08~0;10~S DR=.2197 D LOOK^IVMPREC9;20~S DR=.2197,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~K2-ZIP CODE;.02~ZCT055K2;.03~1;.04~2;.05~.2198;.08~0;10~S DR=.2198 D LOOK^IVMPREC9;20~S DR=.2198 D LOOK^IVMPREC9

 ;;.01~K2-PHONE NUMBER;.02~ZCT06K2;.03~1;.04~2;.05~.2199;.08~0;10~S DR=.2199 D LOOK^IVMPREC9;20~S DR=.2199 D LOOK^IVMPREC9

 ;;.01~K2-WORK PHONE NUMBER;.02~ZCT07K2;.03~1;.04~2;.05~.211011;.08~0;10~S DR=.211011 D LOOK^IVMPREC9;20~S DR=.211011 D LOOK^IVMPREC9

 ;;.01~SECONDARY NOK CHANGE DT/TM;.02~ZCT10K2;.03~1;.04~2;.05~.211012;.06~1;.08~0;10~S DR=.211012 D LOOK^IVMPREC9;20~S DR=.211012,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~D-NAME OF DESIGNEE;.02~ZCT03D1;.03~1;.04~2;.05~.341;.08~0;10~S DR=.341 D LOOK^IVMPREC9;20~S DR=.341 D LOOK^IVMPREC9

 ;;.01~D-RELATIONSHIP TO PATIENT;.02~ZCT04D1;.03~1;.04~2;.05~.342;.08~0;10~S DR=.342 D LOOK^IVMPREC9;20~S DR=.342 D LOOK^IVMPREC9

 ;;.01~D-STREET ADDRESS [LINE 1];.02~ZCT051D1;.03~1;.04~2;.05~.343;.08~0;10~S DR=.343 D LOOK^IVMPREC9;20~S DR=.343 D LOOK^IVMPREC9

 ;;.01~D-STREET ADDRESS [LINE 2];.02~ZCT052D1;.03~1;.04~2;.05~.344;.08~0;10~S DR=.344 D LOOK^IVMPREC9;20~S DR=.344 D LOOK^IVMPREC9

 ;;.01~D-CITY;.02~ZCT053D1;.03~1;.04~2;.05~.346;.08~0;10~S DR=.346 D LOOK^IVMPREC9;20~S DR=.346 D LOOK^IVMPREC9

 ;;.01~D-STATE;.02~ZCT054D1;.03~1;.04~2;.05~.347;.06~1;.08~0;10~S DR=.347 D LOOK^IVMPREC9;20~S DR=.347,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~D-ZIP CODE;.02~ZCT055D1;.03~1;.04~2;.05~.348;.08~0;10~S DR=.348 D LOOK^IVMPREC9;20~S DR=.348 D LOOK^IVMPREC9

 ;;.01~D-PHONE NUMBER;.02~ZCT06D1;.03~1;.04~2;.05~.349;.08~0;10~S DR=.349 D LOOK^IVMPREC9;20~S DR=.349 D LOOK^IVMPREC9

 ;;.01~D-WORK PHONE NUMBER;.02~ZCT07D1;.03~1;.04~2;.05~.34011;.08~0;10~S DR=.34011 D LOOK^IVMPREC9;20~S DR=.34011 D LOOK^IVMPREC9

 ;;.01~DESIGNEE CHANGE DATE/TIME;.02~ZCT10D1;.03~1;.04~2;.05~.3412;.06~1;.08~0;10~S DR=.3412 D LOOK^IVMPREC9;20~S DR=.3412,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~EMPLOYMENT STATUS;.02~ZEM03;.03~1;.04~2;.05~.31115;.06~1;.08~0;10~S DR=.31115 D LOOK^IVMPREC9;20~S DR=.31115,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~EMPLOYER NAME;.02~ZEM04;.03~1;.04~2;.05~.3111;.08~0;10~S DR=.3111 D LOOK^IVMPREC9;20~S DR=.3111 D LOOK^IVMPREC9

 ;;.01~OCCUPATION;.02~ZEM05;.03~1;.04~2;.05~.07;.08~0;10~S DR=.07 D LOOK^IVMPREC9;20~S DR=.07 D LOOK^IVMPREC9

 ;;.01~EMPLOYER ADDR [LINE 1];.02~ZEM061;.03~1;.04~2;.05~.3113;.08~0;10~S DR=.3113 D LOOK^IVMPREC9;20~S DR=.3113 D LOOK^IVMPREC9

 ;;.01~EMPLOYER ADDR [LINE 2];.02~ZEM062;.03~1;.04~2;.05~.3114;.08~0;10~S DR=.3114 D LOOK^IVMPREC9;20~S DR=.3114 D LOOK^IVMPREC9

 ;;.01~EMPLOYER ADDR [LINE 3];.02~ZEM068;.03~1;.04~2;.05~.3115;.08~0;10~S DR=.3115 D LOOK^IVMPREC9;20~S DR=.3115 D LOOK^IVMPREC9

 ;;.01~EMPLOYER CITY;.02~ZEM063;.03~1;.04~2;.05~.3116;.08~0;10~S DR=.3116 D LOOK^IVMPREC9;20~S DR=.3116 D LOOK^IVMPREC9

 ;;.01~EMPLOYER STATE;.02~ZEM064;.03~1;.04~2;.05~.3117;.06~1;.08~0;10~S DR=.3117 D LOOK^IVMPREC9;20~S DR=.3117,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~EMPLOYER ZIP;.02~ZEM065;.03~1;.04~2;.05~.3118;.08~0;10~S DR=.3118 D LOOK^IVMPREC9;20~S DR=.3118 D LOOK^IVMPREC9

 ;;.01~EMPLOYER TELEPHONE;.02~ZEM07;.03~1;.04~2;.05~.3119;.08~0;10~S DR=.3119 D LOOK^IVMPREC9;20~S DR=.3119 D LOOK^IVMPREC9

 ;;.01~RETIREMENT DATE;.02~ZEM09;.03~1;.04~2;.05~.31116;.06~1;.08~0;10~S DR=.31116 D LOOK^IVMPREC9;20~S DR=.31116,DIQ(0)="E" D LOOK^IVMPREC9

 ;;QUIT

 ;;

 ;;The following have been disabled until further notice

 ;;.01~PLACE OF BIRTH CITY;.02~PID113N;.03~1;.04~2;.05~.092;.08~0;10~S DR=.092 D LOOK^IVMPREC9;20~S DR=.092 D LOOK^IVMPREC9

 ;;.01~PLACE OF BIRTH STATE;.02~PID114N;.03~1;.04~2;.05~.093;.06~1;.08~0;10~S DR=.093 D LOOK^IVMPREC9;20~S DR=.093,DIQ(0)="E" D LOOK^IVMPREC9

 ;;.01~CONFIDENTIAL STREET [LINE 1];.02~PID111C;.03~1;.04~2;.05~.1411;.08~0;10~S Y=$P(VAPA(13),"^");20~S Y=$P(VAPA(13),"^")

 ;;.01~CONFIDENTIAL STREET [LINE 2];.02~PID112C;.03~1;.04~2;.05~.1412;.08~0;10~S Y=$P(VAPA(14),"^");20~S Y=$P(VAPA(14),"^")

 ;;.01~CONFIDENTIAL STREET [LINE 3];.02~PID118C;.03~1;.04~2;.05~.1413;.08~0;10~S Y=$P(VAPA(15),"^");20~S Y=$P(VAPA(15),"^")

 ;;.01~CONFIDENTIAL ADDR CITY;.02~PID113C;.03~1;.04~2;.05~.1414;.08~0;10~S Y=$P(VAPA(16),"^");20~S Y=$P(VAPA(16),"^")

 ;;.01~CONFIDENTIAL ADDR STATE;.02~PID114C;.03~1;.04~2;.05~.1415;.06~1;.08~0;10~S Y=$P(VAPA(17),"^");20~S Y=$P(VAPA(17),"^",2)

 ;;.01~CONFIDENTIAL ADDR ZIP CODE;.02~PID115C;.03~1;.04~2;.05~.1416;.08~0;10~S Y=$P(VAPA(18),"^");20~S Y=$P(VAPA(18),"^",2)

 ;;.01~CONFIDENTIAL ADDR PROVINCE;.02~PID114CF;.03~1;.04~2;.05~.14114;.08~0;10~S Y=$P(VAPA(26),"^");20~S Y=$P(VAPA(26),"^")

 ;;.01~CONFIDENTIAL ADDR POSTAL CODE;.02~PID115CF;.03~1;.04~2;.05~.14115;.08~0;10~S Y=$P(VAPA(27),"^");20~S Y=$P(VAPA(27),"^")

 ;;.01~CONFIDENTIAL START DATE;.02~PID1112C1;.03~1;.04~2;.05~.1417;.06~1;.08~0;10~S Y=$P(VAPA(20),"^");20~S Y=$P(VAPA(20),"^",2)

 ;;.01~CONFIDENTIAL END DATE;.02~PID1112C2;.03~1;.04~2;.05~.1418;.06~1;.08~0;10~S Y=$P(VAPA(21),"^");20~S Y=$P(VAPA(21),"^",2)

 ;;.01~CONFIDENTIAL ADDR COUNTRY;.02~PID116C;.03~1;.04~2;.05~.14116;.06~1;.08~0;10~S Y=$P(VAPA(28),"^");20~S Y=$P(VAPA(28),"^",2)

 ;;.01~CONFIDENTIAL ADDR CATEGORY;.02~PID117C;.03~1;.04~2;.05~.141;.08~0;10~S Y=$P(VAPA(22),"^");20~S Y=$P(VAPA(22),"^",2)

 ;;.01~CONFIDENTIAL ADDR COUNTY;.02~PID119C;.03~1;.04~2;.05~.14111;.06~0;.08~0;10~S Y=$P($G(^DIC(5,+VAPA(5),1,+VAPA(19),0)),"^",3);20~S Y=$P(VAPA(19),"^",2)

 ;;.01~MULTIPLE BIRTH INDICATOR;.02~PID24;.03~1;.04~2;.05~994;.08~0;10~S DR=994 D LOOK^IVMPREC9;20~S DR=994 D LOOK^IVMPREC9

 ;;.01~CONFIDENTIAL PHONE NUMBER;.02~PID13CA;.03~1;.04~2;.05~.1315;.08~0;10~S Y=$P(VAPA(29),"^");20~S Y=$P(VAPA(29),"^")

 ;;.01~FATHER'S NAME;.02~ZPD06;.03~1;.04~2;.05~.2401;.08~0;10~S DR=.2401 D LOOK^IVMPREC9;20~S DR=.2401 D LOOK^IVMPREC9

 ;;.01~MOTHER'S NAME;.02~ZPD07;.03~1;.04~2;.05~.2402;.08~0;10~S DR=.2402 D LOOK^IVMPREC9;20~S DR=.2402 D LOOK^IVMPREC9

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DG53754P   14637     printed  Dec 13, 2024@02:38:42                                                                                                                                                                                                   Page 2

DG53754P  ;ALB/TDM - Patch DG*5.3*754 Install Utility Routine ; 7/22/10 10:58am

 +1       ;;5.3;Registration;**754**;AUG 13, 1993;Build 46

 +2        QUIT 

EP        ;Entry point - Driver

 +1        NEW ABORT,FILE,I,ELEMNT,EXIST,DGDATA,DATA,SUB,J,VALUE,FILEFLG

 +2       ;

 +3       ;Run field definition clean-up per EVC_CR9102

           DO START^DG53754A

 +4       ;

 +5        SET (ABORT,FILEFLG)=0

           SET FILE=301.92

 +6        FOR I=1:1

               SET ELEMNT=$PIECE($TEXT(TEXT+I),";;",2)

               if ELEMNT="QUIT"!(ABORT)

                   QUIT 

               Begin DoDot:1

 +7                SET EXIST=0

 +8                KILL DGDATA

                   SET (DATA,SUB)=""

                   FOR J=1:1:$LENGTH(ELEMNT,";")

                       SET DATA=$PIECE(ELEMNT,";",J)

                       Begin DoDot:2

 +9                        SET SUB=$PIECE(DATA,"~",1)

                           SET VALUE=$PIECE(DATA,"~",2)

                           SET DGDATA(SUB)=VALUE

 +10                       IF SUB=.01

                               SET EXIST=$$FIND1^DIC(FILE,,,DGDATA(.01))

                       End DoDot:2

                       if EXIST

                           QUIT 

 +11               IF 'EXIST

                       Begin DoDot:2

 +12                       SET FILEFLG=$$ADD^DGENDBS(FILE,,.DGDATA)

 +13                       IF FILEFLG

                               DO MES^XPDUTL("Added - "_$GET(DGDATA(.01)))

 +14                       IF 'FILEFLG

                               Begin DoDot:3

 +15                               SET ABORT=1

                                   SET XPDABORT=2

 +16                               DO BMES^XPDUTL("Install process could not add an entry in file for "_$GET(DGDATA(.01)))

 +17                               DO BMES^XPDUTL("                        <<<< INSTALLATION ABORTED >>>>")

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18      ;Continuation due to routine size limit

           IF 'ABORT

               DO EP^DG53754C

 +19       IF 'ABORT

               DO BMES^XPDUTL("<<<< Post Install Successful >>>>")

 +20       QUIT 

 +21      ;

TEXT      ;;FIELD#~VALUE;FIELD#~VALUE;FIELD#~VALUE.....

 +1       ;;.01~MOTHER'S MAIDEN NAME;.02~PID06;.03~1;.04~2;.05~.2403;.08~0;10~S DR=.2403 D LOOK^IVMPREC9;20~S DR=.2403 D LOOK^IVMPREC9

 +2       ;;.01~RACE;.02~PID10;.03~1;.04~2;.05~2;.08~0;10~S Y=$P(VADM(12),"^");20~S Y=$P(VADM(12),"^",2)

 +3       ;;.01~MARITAL STATUS;.02~PID16;.03~1;.04~2;.05~.05;.06~1;.08~0;10~S Y=$P(VADM(10),"^");20~S Y=$P(VADM(10),"^",2)

 +4       ;;.01~RELIGION;.02~PID17;.03~1;.04~2;.05~.08;.06~1;.08~0;10~S Y=$P(VADM(9),"^");20~S Y=$P(VADM(9),"^",2)

 +5       ;;.01~ETHNICITY;.02~PID22;.03~1;.04~2;.05~6;.06~1;.08~0;10~S Y=$P($G(VADM(11,1)),"^");20~S Y=$P($G(VADM(11,1)),"^",2)

 +6       ;;.01~SPINAL CORD INJURY;.02~ZPD30;.03~0;.04~2;.05~57.4;.08~0;10~S DR=57.4 D LOOK^IVMPREC9;20~S DR=57.4,DIQ(0)="E" D LOOK^IVMPREC9

 +7       ;;.01~PSEUDO SSN REASON;.02~ZPD34;.03~1;.04~2;.05~.0906;.08~0;10~S DR=.0906 D LOOK^IVMPREC9;20~S DR=.0906,DIQ(0)="E" D LOOK^IVMPREC9

 +8       ;;.01~TEMPORARY ADDRESS ACTIVE;.02~ZTA02;.03~1;.04~2;.05~.12105;.08~0;10~S DR=.12105 D LOOK^IVMPREC9;20~S DR=.12105 D LOOK^IVMPREC9

 +9       ;;.01~TEMPORARY ADDRESS BEGIN DATE;.02~ZTA03;.03~1;.04~2;.05~.1217;.06~1;.08~0;10~S DR=.1217 D LOOK^IVMPREC9;20~S DR=.1217,DIQ(0)="E" D LOOK^IVMPREC9

 +10      ;;.01~TEMPORARY ADDRESS END DATE;.02~ZTA04;.03~1;.04~2;.05~.1218;.06~1;.08~0;10~S DR=.1218 D LOOK^IVMPREC9;20~S DR=.1218,DIQ(0)="E" D LOOK^IVMPREC9

 +11      ;;.01~TEMPORARY ADDRESS [LINE] 1;.02~ZTA051;.03~1;.04~2;.05~.1211;.08~0;10~S DR=.1211 D LOOK^IVMPREC9;20~S DR=.1211 D LOOK^IVMPREC9

 +12      ;;.01~TEMPORARY ADDRESS [LINE] 2;.02~ZTA052;.03~1;.04~2;.05~.1212;.08~0;10~S DR=.1212 D LOOK^IVMPREC9;20~S DR=.1212 D LOOK^IVMPREC9

 +13      ;;.01~TEMPORARY ADDRESS [LINE] 3;.02~ZTA058;.03~1;.04~2;.05~.1213;.08~0;10~S DR=.1213 D LOOK^IVMPREC9;20~S DR=.1213 D LOOK^IVMPREC9

 +14      ;;.01~TEMPORARY ADDRESS CITY;.02~ZTA053;.03~1;.04~2;.05~.1214;.08~0;10~S DR=.1214 D LOOK^IVMPREC9;20~S DR=.1214 D LOOK^IVMPREC9

 +15      ;;.01~TEMPORARY ADDRESS STATE;.02~ZTA054;.03~1;.04~2;.05~.1215;.06~1;.08~0;10~S DR=.1215 D LOOK^IVMPREC9;20~S DR=.1215,DIQ(0)="E" D LOOK^IVMPREC9

 +16      ;;.01~TEMPORARY ADDRESS ZIP;.02~ZTA055;.03~1;.04~2;.05~.1216;.08~0;10~S DR=.1216 D LOOK^IVMPREC9;S DR=.1216 D LOOK^IVMPREC9

 +17      ;;.01~TEMPORARY ADDRESS COUNTRY;.02~ZTA056;.03~1;.04~2;.05~.1223;.06~1;.08~0;10~S DR=.1223 D LOOK^IVMPREC9;S DR=.1223,DIQ(0)="E" D LOOK^IVMPREC9

 +18      ;;.01~TEMPORARY ADDRESS COUNTY;.02~ZTA059;.03~1;.04~2;.05~.12111;.06~1;.08~0;10~S DR=.12111 D LOOK^IVMPREC9;S DR=.12111 D LOOK^IVMPREC9

 +19      ;;.01~TEMPORARY ADDRESS PROVINCE;.02~ZTA054F;.03~1;.04~2;.05~.1221;.08~0;10~S DR=.1221 D LOOK^IVMPREC9;20~S DR=.1221 D LOOK^IVMPREC9"

 +20      ;;.01~TEMPORARY ADDRESS POSTAL CODE;.02~ZTA055F;.03~1;.04~2;.05~.1222;.08~0;10~S DR=.1222 D LOOK^IVMPREC9;20~S DR=.1222 D LOOK^IVMPREC9"

 +21      ;;.01~TEMPORARY ADDRESS TELEPHONE;.02~ZTA07;.03~1;.04~2;.05~.1219;.08~0;10~S DR=.1219 D LOOK^IVMPREC9;20~S DR=.1219 D LOOK^IVMPREC9

 +22      ;;.01~TEMP ADDR LAST UPDATED DT/TM;.02~ZTA08;.03~1;.04~2;.05~.12113;.06~1;.08~0;10~S DR=.12113 D LOOK^IVMPREC9;20~S DR=.12113,DIQ(0)="E" D LOOK^IVMPREC9

 +23      ;;.01~TEMP ADDR LAST UPDATED SITE;.02~ZTA09;.03~1;.04~2;.05~.12114;.06~1;.08~0;10~S DR=.12114 D LOOK^IVMPREC9;20~S DR=.12114 D LOOK^IVMPREC9

 +24      ;;.01~E-NAME;.02~ZCT03E1;.03~1;.04~2;.05~.331;.08~0;10~S DR=.331 D LOOK^IVMPREC9;20~S DR=.331 D LOOK^IVMPREC9

 +25      ;;.01~E-RELATIONSHIP TO PATIENT;.02~ZCT04E1;.03~1;.04~2;.05~.332;.08~0;10~S DR=.332 D LOOK^IVMPREC9;20~S DR=.332 D LOOK^IVMPREC9

 +26      ;;.01~E-STREET ADDRESS [LINE 1];.02~ZCT051E1;.03~1;.04~2;.05~.333;.08~0;10~S DR=.333 D LOOK^IVMPREC9;20~S DR=.333 D LOOK^IVMPREC9

 +27      ;;.01~E-STREET ADDRESS [LINE 2];.02~ZCT052E1;.03~1;.04~2;.05~.334;.08~0;10~S DR=.334 D LOOK^IVMPREC9;20~S DR=.334 D LOOK^IVMPREC9

 +28      ;;.01~E-CITY;.02~ZCT053E1;.03~1;.04~2;.05~.336;.08~0;10~S DR=.336 D LOOK^IVMPREC9;20~S DR=.336 D LOOK^IVMPREC9

 +29      ;;.01~E-STATE;.02~ZCT054E1;.03~1;.04~2;.05~.337;.06~1;.08~0;10~S DR=.337 D LOOK^IVMPREC9;20~S DR=.337,DIQ(0)="E" D LOOK^IVMPREC9

 +30      ;;.01~E-ZIP CODE;.02~ZCT055E1;.03~1;.04~2;.05~.338;.08~0;10~S DR=.338 D LOOK^IVMPREC9;20~S DR=.338 D LOOK^IVMPREC9

 +31      ;;.01~E-PHONE NUMBER;.02~ZCT06E1;.03~1;.04~2;.05~.339;.08~0;10~S DR=.339 D LOOK^IVMPREC9;20~S DR=.339 D LOOK^IVMPREC9

 +32      ;;.01~E-WORK PHONE NUMBER;.02~ZCT07E1;.03~1;.04~2;.05~.33011;.08~0;10~S DR=.33011 D LOOK^IVMPREC9;20~S DR=.33011 D LOOK^IVMPREC9

 +33      ;;.01~E-CONTACT CHANGE DATE/TIME;.02~ZCT10E1;.03~1;.04~2;.05~.33012;.06~1;.08~0;10~S DR=.33012 D LOOK^IVMPREC9;20~S DR=.33012,DIQ(0)="E" D LOOK^IVMPREC9

 +34      ;;.01~E2-NAME OF SECONDARY CONTACT;.02~ZCT03E2;.03~1;.04~2;.05~.3311;.08~0;10~S DR=.3311 D LOOK^IVMPREC9;20~S DR=.3311 D LOOK^IVMPREC9

 +35      ;;.01~E2-RELATIONSHIP TO PATIENT;.02~ZCT04E2;.03~1;.04~2;.05~.3312;.08~0;10~S DR=.3312 D LOOK^IVMPREC9;20~S DR=.3312 D LOOK^IVMPREC9

 +36      ;;.01~E2-STREET ADDRESS [LINE 1];.02~ZCT051E2;.03~1;.04~2;.05~.3313;.08~0;10~S DR=.3313 D LOOK^IVMPREC9;20~S DR=.3313 D LOOK^IVMPREC9

 +37      ;;.01~E2-STREET ADDRESS [LINE 2];.02~ZCT052E2;.03~1;.04~2;.05~.3314;.08~0;10~S DR=.3314 D LOOK^IVMPREC9;20~S DR=.3314 D LOOK^IVMPREC9

 +38      ;;.01~E2-CITY;.02~ZCT053E2;.03~1;.04~2;.05~.3316;.08~0;10~S DR=.3316 D LOOK^IVMPREC9;20~S DR=.3316 D LOOK^IVMPREC9

 +39      ;;.01~E2-STATE;.02~ZCT054E2;.03~1;.04~2;.05~.3317;.06~1;.08~0;10~S DR=.3317 D LOOK^IVMPREC9;20~S DR=.3317,DIQ(0)="E" D LOOK^IVMPREC9

 +40      ;;.01~E2-ZIP CODE;.02~ZCT055E2;.03~1;.04~2;.05~.3318;.08~0;10~S DR=.3318 D LOOK^IVMPREC9;20~S DR=.3318 D LOOK^IVMPREC9

 +41      ;;.01~E2-PHONE NUMBER;.02~ZCT06E2;.03~1;.04~2;.05~.3319;.08~0;10~S DR=.3319 D LOOK^IVMPREC9;20~S DR=.3319 D LOOK^IVMPREC9

 +42      ;;.01~E2-WORK PHONE NUMBER;.02~ZCT07E2;.03~1;.04~2;.05~.331011;.08~0;10~S DR=.331011 D LOOK^IVMPREC9;20~S DR=.331011 D LOOK^IVMPREC9

 +43      ;;.01~E2-CONTACT CHANGE DATE/TIME;.02~ZCT10E2;.03~1;.04~2;.05~.33112;.06~1;.08~0;10~S DR=.33112 D LOOK^IVMPREC9;20~S DR=.33112,DIQ(0)="E" D LOOK^IVMPREC9

 +44      ;;.01~K-NAME OF PRIMARY NOK;.02~ZCT03K1;.03~1;.04~2;.05~.211;.08~0;10~S DR=.211 D LOOK^IVMPREC9;20~S DR=.211 D LOOK^IVMPREC9

 +45      ;;.01~K-RELATIONSHIP TO PATIENT;.02~ZCT04K1;.03~1;.04~2;.05~.212;.08~0;10~S DR=.212 D LOOK^IVMPREC9;20~S DR=.212 D LOOK^IVMPREC9

 +46      ;;.01~K-STREET ADDRESS [LINE 1];.02~ZCT051K1;.03~1;.04~2;.05~.213;.08~0;10~S DR=.213 D LOOK^IVMPREC9;20~S DR=.213 D LOOK^IVMPREC9

 +47      ;;.01~K-STREET ADDRESS [LINE 2];.02~ZCT052K1;.03~1;.04~2;.05~.214;.08~0;10~S DR=.214 D LOOK^IVMPREC9;20~S DR=.214 D LOOK^IVMPREC9

 +48      ;;.01~K-CITY;.02~ZCT053K1;.03~1;.04~2;.05~.216;.08~0;10~S DR=.216 D LOOK^IVMPREC9;20~S DR=.216 D LOOK^IVMPREC9

 +49      ;;.01~K-STATE;.02~ZCT054K1;.03~1;.04~2;.05~.217;.06~1;.08~0;10~S DR=.217 D LOOK^IVMPREC9;20~S DR=.217,DIQ(0)="E" D LOOK^IVMPREC9

 +50      ;;.01~K-ZIP CODE;.02~ZCT055K1;.03~1;.04~2;.05~.218;.08~0;10~S DR=.218 D LOOK^IVMPREC9;20~S DR=.218 D LOOK^IVMPREC9

 +51      ;;.01~K-PHONE NUMBER;.02~ZCT06K1;.03~1;.04~2;.05~.219;.08~0;10~S DR=.219 D LOOK^IVMPREC9;20~S DR=.219 D LOOK^IVMPREC9

 +52      ;;.01~K-WORK PHONE NUMBER;.02~ZCT07K1;.03~1;.04~2;.05~.21011;.08~0;10~S DR=.21011 D LOOK^IVMPREC9;20~S DR=.21011 D LOOK^IVMPREC9

 +53      ;;.01~PRIMARY NOK CHANGE DATE/TIME;.02~ZCT10K1;.03~1;.04~2;.05~.21012;.06~1;.08~0;10~S DR=.21012 D LOOK^IVMPREC9;20~S DR=.21012,DIQ(0)="E" D LOOK^IVMPREC9

 +54      ;;.01~K2-NAME OF SECONDARY NOK;.02~ZCT03K2;.03~1;.04~2;.05~.2191;.08~0;10~S DR=.2191 D LOOK^IVMPREC9;20~S DR=.2191 D LOOK^IVMPREC9

 +55      ;;.01~K2-RELATIONSHIP TO PATIENT;.02~ZCT04K2;.03~1;.04~2;.05~.2192;.08~0;10~S DR=.2192 D LOOK^IVMPREC9;20~S DR=.2192 D LOOK^IVMPREC9

 +56      ;;.01~K2-STREET ADDRESS [LINE 1];.02~ZCT051K2;.03~1;.04~2;.05~.2193;.08~0;10~S DR=.2193 D LOOK^IVMPREC9;20~S DR=.2193 D LOOK^IVMPREC9

 +57      ;;.01~K2-STREET ADDRESS [LINE 2];.02~ZCT052K2;.03~1;.04~2;.05~.2194;.08~0;10~S DR=.2194 D LOOK^IVMPREC9;20~S DR=.2194 D LOOK^IVMPREC9

 +58      ;;.01~K2-CITY;.02~ZCT053K2;.03~1;.04~2;.05~.2196;.08~0;10~S DR=.2196 D LOOK^IVMPREC9;20~S DR=.2196 D LOOK^IVMPREC9

 +59      ;;.01~K2-STATE;.02~ZCT054K2;.03~1;.04~2;.05~.2197;.06~1;.08~0;10~S DR=.2197 D LOOK^IVMPREC9;20~S DR=.2197,DIQ(0)="E" D LOOK^IVMPREC9

 +60      ;;.01~K2-ZIP CODE;.02~ZCT055K2;.03~1;.04~2;.05~.2198;.08~0;10~S DR=.2198 D LOOK^IVMPREC9;20~S DR=.2198 D LOOK^IVMPREC9

 +61      ;;.01~K2-PHONE NUMBER;.02~ZCT06K2;.03~1;.04~2;.05~.2199;.08~0;10~S DR=.2199 D LOOK^IVMPREC9;20~S DR=.2199 D LOOK^IVMPREC9

 +62      ;;.01~K2-WORK PHONE NUMBER;.02~ZCT07K2;.03~1;.04~2;.05~.211011;.08~0;10~S DR=.211011 D LOOK^IVMPREC9;20~S DR=.211011 D LOOK^IVMPREC9

 +63      ;;.01~SECONDARY NOK CHANGE DT/TM;.02~ZCT10K2;.03~1;.04~2;.05~.211012;.06~1;.08~0;10~S DR=.211012 D LOOK^IVMPREC9;20~S DR=.211012,DIQ(0)="E" D LOOK^IVMPREC9

 +64      ;;.01~D-NAME OF DESIGNEE;.02~ZCT03D1;.03~1;.04~2;.05~.341;.08~0;10~S DR=.341 D LOOK^IVMPREC9;20~S DR=.341 D LOOK^IVMPREC9

 +65      ;;.01~D-RELATIONSHIP TO PATIENT;.02~ZCT04D1;.03~1;.04~2;.05~.342;.08~0;10~S DR=.342 D LOOK^IVMPREC9;20~S DR=.342 D LOOK^IVMPREC9

 +66      ;;.01~D-STREET ADDRESS [LINE 1];.02~ZCT051D1;.03~1;.04~2;.05~.343;.08~0;10~S DR=.343 D LOOK^IVMPREC9;20~S DR=.343 D LOOK^IVMPREC9

 +67      ;;.01~D-STREET ADDRESS [LINE 2];.02~ZCT052D1;.03~1;.04~2;.05~.344;.08~0;10~S DR=.344 D LOOK^IVMPREC9;20~S DR=.344 D LOOK^IVMPREC9

 +68      ;;.01~D-CITY;.02~ZCT053D1;.03~1;.04~2;.05~.346;.08~0;10~S DR=.346 D LOOK^IVMPREC9;20~S DR=.346 D LOOK^IVMPREC9

 +69      ;;.01~D-STATE;.02~ZCT054D1;.03~1;.04~2;.05~.347;.06~1;.08~0;10~S DR=.347 D LOOK^IVMPREC9;20~S DR=.347,DIQ(0)="E" D LOOK^IVMPREC9

 +70      ;;.01~D-ZIP CODE;.02~ZCT055D1;.03~1;.04~2;.05~.348;.08~0;10~S DR=.348 D LOOK^IVMPREC9;20~S DR=.348 D LOOK^IVMPREC9

 +71      ;;.01~D-PHONE NUMBER;.02~ZCT06D1;.03~1;.04~2;.05~.349;.08~0;10~S DR=.349 D LOOK^IVMPREC9;20~S DR=.349 D LOOK^IVMPREC9

 +72      ;;.01~D-WORK PHONE NUMBER;.02~ZCT07D1;.03~1;.04~2;.05~.34011;.08~0;10~S DR=.34011 D LOOK^IVMPREC9;20~S DR=.34011 D LOOK^IVMPREC9

 +73      ;;.01~DESIGNEE CHANGE DATE/TIME;.02~ZCT10D1;.03~1;.04~2;.05~.3412;.06~1;.08~0;10~S DR=.3412 D LOOK^IVMPREC9;20~S DR=.3412,DIQ(0)="E" D LOOK^IVMPREC9

 +74      ;;.01~EMPLOYMENT STATUS;.02~ZEM03;.03~1;.04~2;.05~.31115;.06~1;.08~0;10~S DR=.31115 D LOOK^IVMPREC9;20~S DR=.31115,DIQ(0)="E" D LOOK^IVMPREC9

 +75      ;;.01~EMPLOYER NAME;.02~ZEM04;.03~1;.04~2;.05~.3111;.08~0;10~S DR=.3111 D LOOK^IVMPREC9;20~S DR=.3111 D LOOK^IVMPREC9

 +76      ;;.01~OCCUPATION;.02~ZEM05;.03~1;.04~2;.05~.07;.08~0;10~S DR=.07 D LOOK^IVMPREC9;20~S DR=.07 D LOOK^IVMPREC9

 +77      ;;.01~EMPLOYER ADDR [LINE 1];.02~ZEM061;.03~1;.04~2;.05~.3113;.08~0;10~S DR=.3113 D LOOK^IVMPREC9;20~S DR=.3113 D LOOK^IVMPREC9

 +78      ;;.01~EMPLOYER ADDR [LINE 2];.02~ZEM062;.03~1;.04~2;.05~.3114;.08~0;10~S DR=.3114 D LOOK^IVMPREC9;20~S DR=.3114 D LOOK^IVMPREC9

 +79      ;;.01~EMPLOYER ADDR [LINE 3];.02~ZEM068;.03~1;.04~2;.05~.3115;.08~0;10~S DR=.3115 D LOOK^IVMPREC9;20~S DR=.3115 D LOOK^IVMPREC9

 +80      ;;.01~EMPLOYER CITY;.02~ZEM063;.03~1;.04~2;.05~.3116;.08~0;10~S DR=.3116 D LOOK^IVMPREC9;20~S DR=.3116 D LOOK^IVMPREC9

 +81      ;;.01~EMPLOYER STATE;.02~ZEM064;.03~1;.04~2;.05~.3117;.06~1;.08~0;10~S DR=.3117 D LOOK^IVMPREC9;20~S DR=.3117,DIQ(0)="E" D LOOK^IVMPREC9

 +82      ;;.01~EMPLOYER ZIP;.02~ZEM065;.03~1;.04~2;.05~.3118;.08~0;10~S DR=.3118 D LOOK^IVMPREC9;20~S DR=.3118 D LOOK^IVMPREC9

 +83      ;;.01~EMPLOYER TELEPHONE;.02~ZEM07;.03~1;.04~2;.05~.3119;.08~0;10~S DR=.3119 D LOOK^IVMPREC9;20~S DR=.3119 D LOOK^IVMPREC9

 +84      ;;.01~RETIREMENT DATE;.02~ZEM09;.03~1;.04~2;.05~.31116;.06~1;.08~0;10~S DR=.31116 D LOOK^IVMPREC9;20~S DR=.31116,DIQ(0)="E" D LOOK^IVMPREC9

 +85      ;;QUIT

 +86      ;;

 +87      ;;The following have been disabled until further notice

 +88      ;;.01~PLACE OF BIRTH CITY;.02~PID113N;.03~1;.04~2;.05~.092;.08~0;10~S DR=.092 D LOOK^IVMPREC9;20~S DR=.092 D LOOK^IVMPREC9

 +89      ;;.01~PLACE OF BIRTH STATE;.02~PID114N;.03~1;.04~2;.05~.093;.06~1;.08~0;10~S DR=.093 D LOOK^IVMPREC9;20~S DR=.093,DIQ(0)="E" D LOOK^IVMPREC9

 +90      ;;.01~CONFIDENTIAL STREET [LINE 1];.02~PID111C;.03~1;.04~2;.05~.1411;.08~0;10~S Y=$P(VAPA(13),"^");20~S Y=$P(VAPA(13),"^")

 +91      ;;.01~CONFIDENTIAL STREET [LINE 2];.02~PID112C;.03~1;.04~2;.05~.1412;.08~0;10~S Y=$P(VAPA(14),"^");20~S Y=$P(VAPA(14),"^")

 +92      ;;.01~CONFIDENTIAL STREET [LINE 3];.02~PID118C;.03~1;.04~2;.05~.1413;.08~0;10~S Y=$P(VAPA(15),"^");20~S Y=$P(VAPA(15),"^")

 +93      ;;.01~CONFIDENTIAL ADDR CITY;.02~PID113C;.03~1;.04~2;.05~.1414;.08~0;10~S Y=$P(VAPA(16),"^");20~S Y=$P(VAPA(16),"^")

 +94      ;;.01~CONFIDENTIAL ADDR STATE;.02~PID114C;.03~1;.04~2;.05~.1415;.06~1;.08~0;10~S Y=$P(VAPA(17),"^");20~S Y=$P(VAPA(17),"^",2)

 +95      ;;.01~CONFIDENTIAL ADDR ZIP CODE;.02~PID115C;.03~1;.04~2;.05~.1416;.08~0;10~S Y=$P(VAPA(18),"^");20~S Y=$P(VAPA(18),"^",2)

 +96      ;;.01~CONFIDENTIAL ADDR PROVINCE;.02~PID114CF;.03~1;.04~2;.05~.14114;.08~0;10~S Y=$P(VAPA(26),"^");20~S Y=$P(VAPA(26),"^")

 +97      ;;.01~CONFIDENTIAL ADDR POSTAL CODE;.02~PID115CF;.03~1;.04~2;.05~.14115;.08~0;10~S Y=$P(VAPA(27),"^");20~S Y=$P(VAPA(27),"^")

 +98      ;;.01~CONFIDENTIAL START DATE;.02~PID1112C1;.03~1;.04~2;.05~.1417;.06~1;.08~0;10~S Y=$P(VAPA(20),"^");20~S Y=$P(VAPA(20),"^",2)

 +99      ;;.01~CONFIDENTIAL END DATE;.02~PID1112C2;.03~1;.04~2;.05~.1418;.06~1;.08~0;10~S Y=$P(VAPA(21),"^");20~S Y=$P(VAPA(21),"^",2)

 +100     ;;.01~CONFIDENTIAL ADDR COUNTRY;.02~PID116C;.03~1;.04~2;.05~.14116;.06~1;.08~0;10~S Y=$P(VAPA(28),"^");20~S Y=$P(VAPA(28),"^",2)

 +101     ;;.01~CONFIDENTIAL ADDR CATEGORY;.02~PID117C;.03~1;.04~2;.05~.141;.08~0;10~S Y=$P(VAPA(22),"^");20~S Y=$P(VAPA(22),"^",2)

 +102     ;;.01~CONFIDENTIAL ADDR COUNTY;.02~PID119C;.03~1;.04~2;.05~.14111;.06~0;.08~0;10~S Y=$P($G(^DIC(5,+VAPA(5),1,+VAPA(19),0)),"^",3);20~S Y=$P(VAPA(19),"^",2)

 +103     ;;.01~MULTIPLE BIRTH INDICATOR;.02~PID24;.03~1;.04~2;.05~994;.08~0;10~S DR=994 D LOOK^IVMPREC9;20~S DR=994 D LOOK^IVMPREC9

 +104     ;;.01~CONFIDENTIAL PHONE NUMBER;.02~PID13CA;.03~1;.04~2;.05~.1315;.08~0;10~S Y=$P(VAPA(29),"^");20~S Y=$P(VAPA(29),"^")

 +105     ;;.01~FATHER'S NAME;.02~ZPD06;.03~1;.04~2;.05~.2401;.08~0;10~S DR=.2401 D LOOK^IVMPREC9;20~S DR=.2401 D LOOK^IVMPREC9

 +106     ;;.01~MOTHER'S NAME;.02~ZPD07;.03~1;.04~2;.05~.2402;.08~0;10~S DR=.2402 D LOOK^IVMPREC9;20~S DR=.2402 D LOOK^IVMPREC9