XUMF682P ;OIFO-BP/BATRAN - MFS parameters file ; 09/19/2017
;;8.0;KERNEL;**682**;Jul 10, 1995;Build 6
;Per VHA Directive 10-92-142, this routine should not be modified
Q
;----------------------------------------------
POST ; -- Entry point
N XUMF S XUMF=1
D 1099,1199,1399
N X S X="XUMF682" X ^%ZOSF("DEL")
K XMY
Q
;----------------------------------------------
TEST ; -- Entry point
N XUMF S XUMF=1
D 1099,1199,1399
K XMY
Q
;
1099 ; FILE #10.99
; -----------FILE 4.001-----------
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=10.99
S XUIEN=$O(^DIC(4.001,"B",10,0)) ;Get existed IEN
I +XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
. D DEL^XUMF682(XUIEN) ; delete entry
S XFILE="Races"
D DEL^XUMF682(XFIEN) ; delete entry
D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",10.99) ; add entry
;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",10) ; add entry
;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
D NODES^XUMF682(XFIEN,"DATA1099",5) ; call ADD1 to add sub_entry
D ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
;
; ----------FILE 4.005 ------------
S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
I +XUIEN>0 D
. D DELMD5^XUMF682(XFILE)
. Q
S XFIEN=10.99
D ADDMD5^XUMF682(XFILE,XFIEN)
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
D SUBMD5^XUMF682(XFILE,"99.97^50^^10.99^",XFIEN,99.97) ;
D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
S XFIEN=10.99901
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
Q
;--------------------------------------------------------------
1199 ; FILE #11.99
; -----------FILE 4.001-----------
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=11.99
S XUIEN=$O(^DIC(4.001,"B",11,0)) ;Get existed IEN
I +XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
. D DEL^XUMF682(XUIEN) ; delete entry
S XFILE="Marital Statuses"
D DEL^XUMF682(XFIEN) ; delete entry
D ADD^XUMF682(XFIEN,".03;Marital Statuses].07;Marital Statuses]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",11.99) ; add entry
;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",11.99) ; add entry
;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
D NODES^XUMF682(XFIEN,"DATA1199",5) ; call ADD1 to add sub_entry
D ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
;
; ----------FILE 4.005 ------------
S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
I +XUIEN>0 D
. D DELMD5^XUMF682(XFILE)
. Q
S XFIEN=11.99
D ADDMD5^XUMF682(XFILE,XFIEN)
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
D SUBMD5^XUMF682(XFILE,"99.97^50^^11.99^",XFIEN,99.97) ;
D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
S XFIEN=11.99901
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
Q
;--------------------------------------------------------------
1399 ; FILE #13.99
; -----------FILE 4.001-----------
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=13.99
S XUIEN=$O(^DIC(4.001,"B",13,0)) ;Get existed IEN
I +XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
. D DEL^XUMF682(XUIEN) ; delete entry
S XFILE="Religions"
D DEL^XUMF682(XFIEN) ; delete entry
D ADD^XUMF682(XFIEN,".03;Religions].07;Religions]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",13.99) ; add entry
;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",13.99) ; add entry
;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
D NODES^XUMF682(XFIEN,"DATA1399",5) ; call ADD1 to add sub_entry
D ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
;
; ----------FILE 4.005 ------------
S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
I +XUIEN>0 D
. D DELMD5^XUMF682(XFILE)
. Q
S XFIEN=13.99
D ADDMD5^XUMF682(XFILE,XFIEN)
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
D SUBMD5^XUMF682(XFILE,"99.97^50^^13.99^",XFIEN,99.97) ;
D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
S XFIEN=13.99901
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
Q
;--------------------------------------------------------------
10 ;FILE 10
; FILE 4.001
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=10
S XUIEN=$O(^DIC(4.001,"B",10,0)) ;Get existed IEN
I +XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
. D DEL^XUMF676(XUIEN) ; delete entry
. S XFIEN=XUIEN
S XFILE="Races"
D DEL^XUMF682(XFIEN) ; delete entry
D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",10) ; add entry
;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
D NODES^XUMF682(XFIEN,"DATA10",8) ; call ADD1 to add sub_entry
D ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
;
; FILE 4.005
S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
I +XUIEN>0 D
. S XFIEN=XUIEN
. D DELMD5^XUMF682(XFILE)
D ADDMD5^XUMF682(XFILE,XFIEN)
S XFIEN=10
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
D SUBMD5^XUMF682(XFILE,"2^30^^^",XFIEN,2) ;
D SUBMD5^XUMF682(XFILE,"4^40^^^",XFIEN,4) ;
D SUBMD5^XUMF682(XFILE,"5^60^^^",XFIEN,5) ;
D SUBMD5^XUMF682(XFILE,"99.97^80^^10^",XFIEN,99.97) ;
D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
S XFIEN=10.01
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^70^^^^",XFIEN,.01)
S XFIEN=10.12
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^50^^^^D MCS10^DGZRT",XFIEN,.01)
Q
;
11 ;FILE 11
; FILE 4.001
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=11
S XUIEN=$O(^DIC(4.001,"B",11,0)) ;Get existed IEN
I +XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
. D DEL^XUMF676(XUIEN) ; delete entry
. S XFIEN=XUIEN
S XFILE="Marital Statuses"
D ADD^XUMF682(XFIEN,".03;Marital Statuses].07;Marital Statuses]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(11,11.31,11.311)",11) ; add entry
;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
D NODES^XUMF682(XFIEN,"DATA11",6) ; call ADD1 to add sub_entry
D ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
;
; FILE 4.005
S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
I +XUIEN>0 D
. S XFIEN=XUIEN
. D DELMD5^XUMF682(XFILE)
D ADDMD5^XUMF682(XFILE,XFIEN)
S XFIEN=11
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
D SUBMD5^XUMF682(XFILE,"2^50^E^^",XFIEN,2) ;
D SUBMD5^XUMF682(XFILE,"99.97^60^^11^",XFIEN,99.97) ;
D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
S XFIEN=11.31
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^40^^^^D MCS11^DGZRT",XFIEN,.01)
Q
;
13 ;FILE 13
; FILE 4.001
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=13
S XUIEN=$O(^DIC(4.001,"B",13,0)) ;Get existed IEN
I +XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
. D DEL^XUMF676(XUIEN) ; delete entry
. S XFIEN=XUIEN
S XFILE="Religions"
D ADD^XUMF682(XFIEN,".03;Religions].07;Religions]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(13,13.11,13.111)",13) ; add entry
;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
D NODES^XUMF682(XFIEN,"DATA13",8) ; call ADD1 to add sub_entry
D ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
;
; FILE 4.005
S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
I +XUIEN>0 D
. S XFIEN=XUIEN
. D DELMD5^XUMF682(XFILE)
D ADDMD5^XUMF682(XFILE,XFIEN)
S XFIEN=13
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
D SUBMD5^XUMF682(XFILE,"2^40^E^^",XFIEN,2) ;
D SUBMD5^XUMF682(XFILE,"3^50^^^",XFIEN,3) ;
D SUBMD5^XUMF682(XFILE,"99.97^80^^13^",XFIEN,99.97) ;
D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
S XFIEN=13.11
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^60^^^^D MCS13^DGZRT",XFIEN,.01)
S XFIEN=13.01
D SCMD5^XUMF682(XFILE,XFIEN)
D SUBMD5^XUMF682(XFILE,".01^70^^^^",XFIEN,.01)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF682P 9107 printed Apr 09, 2024@21:08:20 Page 2
XUMF682P ;OIFO-BP/BATRAN - MFS parameters file ; 09/19/2017
+1 ;;8.0;KERNEL;**682**;Jul 10, 1995;Build 6
+2 ;Per VHA Directive 10-92-142, this routine should not be modified
+3 QUIT
+4 ;----------------------------------------------
POST ; -- Entry point
+1 NEW XUMF
SET XUMF=1
+2 DO 1099
DO 1199
DO 1399
+3 NEW X
SET X="XUMF682"
XECUTE ^%ZOSF("DEL")
+4 KILL XMY
+5 QUIT
+6 ;----------------------------------------------
TEST ; -- Entry point
+1 NEW XUMF
SET XUMF=1
+2 DO 1099
DO 1199
DO 1399
+3 KILL XMY
+4 QUIT
+5 ;
1099 ; FILE #10.99
+1 ; -----------FILE 4.001-----------
+2 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+3 SET XFIEN=10.99
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",10,0))
+5 IF +XUIEN>0
Begin DoDot:1
+6 ;get Mail Group pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF682(XUIEN)
End DoDot:1
+8 SET XFILE="Races"
+9 ; delete entry
DO DEL^XUMF682(XFIEN)
+10 ; add entry
DO ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",10.99)
+11 ;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",10) ; add entry
+12 ;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
+13 ; call ADD1 to add sub_entry
DO NODES^XUMF682(XFIEN,"DATA1099",5)
+14 DO ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
+15 ;
+16 ; ----------FILE 4.005 ------------
+17 SET XUIEN=$ORDER(^DIC(4.005,"B",XFILE,0))
+18 IF +XUIEN>0
Begin DoDot:1
+19 DO DELMD5^XUMF682(XFILE)
+20 QUIT
End DoDot:1
+21 SET XFIEN=10.99
+22 DO ADDMD5^XUMF682(XFILE,XFIEN)
+23 DO SCMD5^XUMF682(XFILE,XFIEN)
+24 ;
DO SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01)
+25 ;
DO SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1)
+26 ;
DO SUBMD5^XUMF682(XFILE,"99.97^50^^10.99^",XFIEN,99.97)
+27 ;
DO SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99)
+28 SET XFIEN=10.99901
+29 DO SCMD5^XUMF682(XFILE,XFIEN)
+30 DO SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
+31 QUIT
+32 ;--------------------------------------------------------------
1199 ; FILE #11.99
+1 ; -----------FILE 4.001-----------
+2 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+3 SET XFIEN=11.99
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",11,0))
+5 IF +XUIEN>0
Begin DoDot:1
+6 ;get Mail Group pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF682(XUIEN)
End DoDot:1
+8 SET XFILE="Marital Statuses"
+9 ; delete entry
DO DEL^XUMF682(XFIEN)
+10 ; add entry
DO ADD^XUMF682(XFIEN,".03;Marital Statuses].07;Marital Statuses]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",11.99)
+11 ;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",11.99) ; add entry
+12 ;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
+13 ; call ADD1 to add sub_entry
DO NODES^XUMF682(XFIEN,"DATA1199",5)
+14 DO ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
+15 ;
+16 ; ----------FILE 4.005 ------------
+17 SET XUIEN=$ORDER(^DIC(4.005,"B",XFILE,0))
+18 IF +XUIEN>0
Begin DoDot:1
+19 DO DELMD5^XUMF682(XFILE)
+20 QUIT
End DoDot:1
+21 SET XFIEN=11.99
+22 DO ADDMD5^XUMF682(XFILE,XFIEN)
+23 DO SCMD5^XUMF682(XFILE,XFIEN)
+24 ;
DO SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01)
+25 ;
DO SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1)
+26 ;
DO SUBMD5^XUMF682(XFILE,"99.97^50^^11.99^",XFIEN,99.97)
+27 ;
DO SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99)
+28 SET XFIEN=11.99901
+29 DO SCMD5^XUMF682(XFILE,XFIEN)
+30 DO SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
+31 QUIT
+32 ;--------------------------------------------------------------
1399 ; FILE #13.99
+1 ; -----------FILE 4.001-----------
+2 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+3 SET XFIEN=13.99
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",13,0))
+5 IF +XUIEN>0
Begin DoDot:1
+6 ;get Mail Group pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF682(XUIEN)
End DoDot:1
+8 SET XFILE="Religions"
+9 ; delete entry
DO DEL^XUMF682(XFIEN)
+10 ; add entry
DO ADD^XUMF682(XFIEN,".03;Religions].07;Religions]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",13.99)
+11 ;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",13.99) ; add entry
+12 ;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
+13 ; call ADD1 to add sub_entry
DO NODES^XUMF682(XFIEN,"DATA1399",5)
+14 DO ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
+15 ;
+16 ; ----------FILE 4.005 ------------
+17 SET XUIEN=$ORDER(^DIC(4.005,"B",XFILE,0))
+18 IF +XUIEN>0
Begin DoDot:1
+19 DO DELMD5^XUMF682(XFILE)
+20 QUIT
End DoDot:1
+21 SET XFIEN=13.99
+22 DO ADDMD5^XUMF682(XFILE,XFIEN)
+23 DO SCMD5^XUMF682(XFILE,XFIEN)
+24 ;
DO SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01)
+25 ;
DO SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1)
+26 ;
DO SUBMD5^XUMF682(XFILE,"99.97^50^^13.99^",XFIEN,99.97)
+27 ;
DO SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99)
+28 SET XFIEN=13.99901
+29 DO SCMD5^XUMF682(XFILE,XFIEN)
+30 DO SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
+31 QUIT
+32 ;--------------------------------------------------------------
10 ;FILE 10
+1 ; FILE 4.001
+2 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+3 SET XFIEN=10
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",10,0))
+5 IF +XUIEN>0
Begin DoDot:1
+6 ;get Mail Group pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF676(XUIEN)
+8 SET XFIEN=XUIEN
End DoDot:1
+9 SET XFILE="Races"
+10 ; delete entry
DO DEL^XUMF682(XFIEN)
+11 ; add entry
DO ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",10)
+12 ;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
+13 ; call ADD1 to add sub_entry
DO NODES^XUMF682(XFIEN,"DATA10",8)
+14 DO ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
+15 ;
+16 ; FILE 4.005
+17 SET XUIEN=$ORDER(^DIC(4.005,"B",XFILE,0))
+18 IF +XUIEN>0
Begin DoDot:1
+19 SET XFIEN=XUIEN
+20 DO DELMD5^XUMF682(XFILE)
End DoDot:1
+21 DO ADDMD5^XUMF682(XFILE,XFIEN)
+22 SET XFIEN=10
+23 DO SCMD5^XUMF682(XFILE,XFIEN)
+24 ;
DO SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01)
+25 ;
DO SUBMD5^XUMF682(XFILE,"2^30^^^",XFIEN,2)
+26 ;
DO SUBMD5^XUMF682(XFILE,"4^40^^^",XFIEN,4)
+27 ;
DO SUBMD5^XUMF682(XFILE,"5^60^^^",XFIEN,5)
+28 ;
DO SUBMD5^XUMF682(XFILE,"99.97^80^^10^",XFIEN,99.97)
+29 ;
DO SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99)
+30 SET XFIEN=10.01
+31 DO SCMD5^XUMF682(XFILE,XFIEN)
+32 DO SUBMD5^XUMF682(XFILE,".01^70^^^^",XFIEN,.01)
+33 SET XFIEN=10.12
+34 DO SCMD5^XUMF682(XFILE,XFIEN)
+35 DO SUBMD5^XUMF682(XFILE,".01^50^^^^D MCS10^DGZRT",XFIEN,.01)
+36 QUIT
+37 ;
11 ;FILE 11
+1 ; FILE 4.001
+2 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+3 SET XFIEN=11
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",11,0))
+5 IF +XUIEN>0
Begin DoDot:1
+6 ;get Mail Group pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF676(XUIEN)
+8 SET XFIEN=XUIEN
End DoDot:1
+9 SET XFILE="Marital Statuses"
+10 ; add entry
DO ADD^XUMF682(XFIEN,".03;Marital Statuses].07;Marital Statuses]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(11,11.31,11.311)",11)
+11 ;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
+12 ; call ADD1 to add sub_entry
DO NODES^XUMF682(XFIEN,"DATA11",6)
+13 DO ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
+14 ;
+15 ; FILE 4.005
+16 SET XUIEN=$ORDER(^DIC(4.005,"B",XFILE,0))
+17 IF +XUIEN>0
Begin DoDot:1
+18 SET XFIEN=XUIEN
+19 DO DELMD5^XUMF682(XFILE)
End DoDot:1
+20 DO ADDMD5^XUMF682(XFILE,XFIEN)
+21 SET XFIEN=11
+22 DO SCMD5^XUMF682(XFILE,XFIEN)
+23 ;
DO SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01)
+24 ;
DO SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1)
+25 ;
DO SUBMD5^XUMF682(XFILE,"2^50^E^^",XFIEN,2)
+26 ;
DO SUBMD5^XUMF682(XFILE,"99.97^60^^11^",XFIEN,99.97)
+27 ;
DO SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99)
+28 SET XFIEN=11.31
+29 DO SCMD5^XUMF682(XFILE,XFIEN)
+30 DO SUBMD5^XUMF682(XFILE,".01^40^^^^D MCS11^DGZRT",XFIEN,.01)
+31 QUIT
+32 ;
13 ;FILE 13
+1 ; FILE 4.001
+2 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+3 SET XFIEN=13
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",13,0))
+5 IF +XUIEN>0
Begin DoDot:1
+6 ;get Mail Group pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF676(XUIEN)
+8 SET XFIEN=XUIEN
End DoDot:1
+9 SET XFILE="Religions"
+10 ; add entry
DO ADD^XUMF682(XFIEN,".03;Religions].07;Religions]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(13,13.11,13.111)",13)
+11 ;D ADD^XUMF682(XFIEN,"4.1;99.99]4.2;.01]4.3;ERT]4.4;.01]4.5;.01]4.6;VA]4.7;CE]4.8;B]4.9;VA]4.11;NM]4.12;ST]4.14;ST]4.15;ST]4.16;NULL]4.17;NULL") ; add entry
+12 ; call ADD1 to add sub_entry
DO NODES^XUMF682(XFIEN,"DATA13",8)
+13 DO ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
+14 ;
+15 ; FILE 4.005
+16 SET XUIEN=$ORDER(^DIC(4.005,"B",XFILE,0))
+17 IF +XUIEN>0
Begin DoDot:1
+18 SET XFIEN=XUIEN
+19 DO DELMD5^XUMF682(XFILE)
End DoDot:1
+20 DO ADDMD5^XUMF682(XFILE,XFIEN)
+21 SET XFIEN=13
+22 DO SCMD5^XUMF682(XFILE,XFIEN)
+23 ;
DO SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01)
+24 ;
DO SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1)
+25 ;
DO SUBMD5^XUMF682(XFILE,"2^40^E^^",XFIEN,2)
+26 ;
DO SUBMD5^XUMF682(XFILE,"3^50^^^",XFIEN,3)
+27 ;
DO SUBMD5^XUMF682(XFILE,"99.97^80^^13^",XFIEN,99.97)
+28 ;
DO SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99)
+29 SET XFIEN=13.11
+30 DO SCMD5^XUMF682(XFILE,XFIEN)
+31 DO SUBMD5^XUMF682(XFILE,".01^60^^^^D MCS13^DGZRT",XFIEN,.01)
+32 SET XFIEN=13.01
+33 DO SCMD5^XUMF682(XFILE,XFIEN)
+34 DO SUBMD5^XUMF682(XFILE,".01^70^^^^",XFIEN,.01)
+35 QUIT
+36 ;
