- 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 Feb 18, 2025@23:37:07 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 ;