Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUMF682P

XUMF682P.m

Go to the documentation of this file.
  1. XUMF682P ;OIFO-BP/BATRAN - MFS parameters file ; 09/19/2017
  1. ;;8.0;KERNEL;**682**;Jul 10, 1995;Build 6
  1. ;Per VHA Directive 10-92-142, this routine should not be modified
  1. Q
  1. ;----------------------------------------------
  1. POST ; -- Entry point
  1. N XUMF S XUMF=1
  1. D 1099,1199,1399
  1. N X S X="XUMF682" X ^%ZOSF("DEL")
  1. K XMY
  1. Q
  1. ;----------------------------------------------
  1. TEST ; -- Entry point
  1. N XUMF S XUMF=1
  1. D 1099,1199,1399
  1. K XMY
  1. Q
  1. ;
  1. 1099 ; FILE #10.99
  1. ; -----------FILE 4.001-----------
  1. N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
  1. S XFIEN=10.99
  1. S XUIEN=$O(^DIC(4.001,"B",10,0)) ;Get existed IEN
  1. I +XUIEN>0 D
  1. . S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
  1. . D DEL^XUMF682(XUIEN) ; delete entry
  1. S XFILE="Races"
  1. D DEL^XUMF682(XFIEN) ; delete entry
  1. D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",10.99) ; add entry
  1. ;D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",10) ; add entry
  1. ;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
  1. D NODES^XUMF682(XFIEN,"DATA1099",5) ; call ADD1 to add sub_entry
  1. D ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
  1. ;
  1. ; ----------FILE 4.005 ------------
  1. S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
  1. I +XUIEN>0 D
  1. . D DELMD5^XUMF682(XFILE)
  1. . Q
  1. S XFIEN=10.99
  1. D ADDMD5^XUMF682(XFILE,XFIEN)
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
  1. D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
  1. D SUBMD5^XUMF682(XFILE,"99.97^50^^10.99^",XFIEN,99.97) ;
  1. D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
  1. S XFIEN=10.99901
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
  1. Q
  1. ;--------------------------------------------------------------
  1. 1199 ; FILE #11.99
  1. ; -----------FILE 4.001-----------
  1. N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
  1. S XFIEN=11.99
  1. S XUIEN=$O(^DIC(4.001,"B",11,0)) ;Get existed IEN
  1. I +XUIEN>0 D
  1. . S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
  1. . D DEL^XUMF682(XUIEN) ; delete entry
  1. S XFILE="Marital Statuses"
  1. D DEL^XUMF682(XFIEN) ; delete entry
  1. 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
  1. ;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
  1. ;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
  1. D NODES^XUMF682(XFIEN,"DATA1199",5) ; call ADD1 to add sub_entry
  1. D ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
  1. ;
  1. ; ----------FILE 4.005 ------------
  1. S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
  1. I +XUIEN>0 D
  1. . D DELMD5^XUMF682(XFILE)
  1. . Q
  1. S XFIEN=11.99
  1. D ADDMD5^XUMF682(XFILE,XFIEN)
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
  1. D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
  1. D SUBMD5^XUMF682(XFILE,"99.97^50^^11.99^",XFIEN,99.97) ;
  1. D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
  1. S XFIEN=11.99901
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
  1. Q
  1. ;--------------------------------------------------------------
  1. 1399 ; FILE #13.99
  1. ; -----------FILE 4.001-----------
  1. N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
  1. S XFIEN=13.99
  1. S XUIEN=$O(^DIC(4.001,"B",13,0)) ;Get existed IEN
  1. I +XUIEN>0 D
  1. . S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
  1. . D DEL^XUMF682(XUIEN) ; delete entry
  1. S XFILE="Religions"
  1. D DEL^XUMF682(XFIEN) ; delete entry
  1. D ADD^XUMF682(XFIEN,".03;Religions].07;Religions]5;D ZRT^DGZRT]2;D POST^DGZRT]6;D DESC^HDIZRT",13.99) ; add entry
  1. ;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
  1. ;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
  1. D NODES^XUMF682(XFIEN,"DATA1399",5) ; call ADD1 to add sub_entry
  1. D ADD2^XUMF682(XFIEN,"VistA_Related_Record",1,"1^VistA_Related_Record^.01^^")
  1. ;
  1. ; ----------FILE 4.005 ------------
  1. S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
  1. I +XUIEN>0 D
  1. . D DELMD5^XUMF682(XFILE)
  1. . Q
  1. S XFIEN=13.99
  1. D ADDMD5^XUMF682(XFILE,XFIEN)
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
  1. D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
  1. D SUBMD5^XUMF682(XFILE,"99.97^50^^13.99^",XFIEN,99.97) ;
  1. D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
  1. S XFIEN=13.99901
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^40^^^^",XFIEN,.01)
  1. Q
  1. ;--------------------------------------------------------------
  1. 10 ;FILE 10
  1. ; FILE 4.001
  1. N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
  1. S XFIEN=10
  1. S XUIEN=$O(^DIC(4.001,"B",10,0)) ;Get existed IEN
  1. I +XUIEN>0 D
  1. . S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
  1. . D DEL^XUMF676(XUIEN) ; delete entry
  1. . S XFIEN=XUIEN
  1. S XFILE="Races"
  1. D DEL^XUMF682(XFIEN) ; delete entry
  1. D ADD^XUMF682(XFIEN,".03;Races].07;Races]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(10,10.12,10.121)",10) ; add entry
  1. ;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
  1. D NODES^XUMF682(XFIEN,"DATA10",8) ; call ADD1 to add sub_entry
  1. D ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
  1. ;
  1. ; FILE 4.005
  1. S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
  1. I +XUIEN>0 D
  1. . S XFIEN=XUIEN
  1. . D DELMD5^XUMF682(XFILE)
  1. D ADDMD5^XUMF682(XFILE,XFIEN)
  1. S XFIEN=10
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
  1. D SUBMD5^XUMF682(XFILE,"2^30^^^",XFIEN,2) ;
  1. D SUBMD5^XUMF682(XFILE,"4^40^^^",XFIEN,4) ;
  1. D SUBMD5^XUMF682(XFILE,"5^60^^^",XFIEN,5) ;
  1. D SUBMD5^XUMF682(XFILE,"99.97^80^^10^",XFIEN,99.97) ;
  1. D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
  1. S XFIEN=10.01
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^70^^^^",XFIEN,.01)
  1. S XFIEN=10.12
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^50^^^^D MCS10^DGZRT",XFIEN,.01)
  1. Q
  1. ;
  1. 11 ;FILE 11
  1. ; FILE 4.001
  1. N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
  1. S XFIEN=11
  1. S XUIEN=$O(^DIC(4.001,"B",11,0)) ;Get existed IEN
  1. I +XUIEN>0 D
  1. . S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
  1. . D DEL^XUMF676(XUIEN) ; delete entry
  1. . S XFIEN=XUIEN
  1. S XFILE="Marital Statuses"
  1. 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
  1. ;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
  1. D NODES^XUMF682(XFIEN,"DATA11",6) ; call ADD1 to add sub_entry
  1. D ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
  1. ;
  1. ; FILE 4.005
  1. S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
  1. I +XUIEN>0 D
  1. . S XFIEN=XUIEN
  1. . D DELMD5^XUMF682(XFILE)
  1. D ADDMD5^XUMF682(XFILE,XFIEN)
  1. S XFIEN=11
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
  1. D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
  1. D SUBMD5^XUMF682(XFILE,"2^50^E^^",XFIEN,2) ;
  1. D SUBMD5^XUMF682(XFILE,"99.97^60^^11^",XFIEN,99.97) ;
  1. D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
  1. S XFIEN=11.31
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^40^^^^D MCS11^DGZRT",XFIEN,.01)
  1. Q
  1. ;
  1. 13 ;FILE 13
  1. ; FILE 4.001
  1. N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
  1. S XFIEN=13
  1. S XUIEN=$O(^DIC(4.001,"B",13,0)) ;Get existed IEN
  1. I +XUIEN>0 D
  1. . S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Group pointer
  1. . D DEL^XUMF676(XUIEN) ; delete entry
  1. . S XFIEN=XUIEN
  1. S XFILE="Religions"
  1. D ADD^XUMF682(XFIEN,".03;Religions].07;Religions]5;D ZRT^DGZRT]6;D DFORALL^GMRAVZRT(13,13.11,13.111)",13) ; add entry
  1. ;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
  1. D NODES^XUMF682(XFIEN,"DATA13",8) ; call ADD1 to add sub_entry
  1. D ADD2^XUMF682(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
  1. ;
  1. ; FILE 4.005
  1. S XUIEN=$O(^DIC(4.005,"B",XFILE,0))
  1. I +XUIEN>0 D
  1. . S XFIEN=XUIEN
  1. . D DELMD5^XUMF682(XFILE)
  1. D ADDMD5^XUMF682(XFILE,XFIEN)
  1. S XFIEN=13
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^20^^^",XFIEN,.01) ;
  1. D SUBMD5^XUMF682(XFILE,"1^30^^^",XFIEN,1) ;
  1. D SUBMD5^XUMF682(XFILE,"2^40^E^^",XFIEN,2) ;
  1. D SUBMD5^XUMF682(XFILE,"3^50^^^",XFIEN,3) ;
  1. D SUBMD5^XUMF682(XFILE,"99.97^80^^13^",XFIEN,99.97) ;
  1. D SUBMD5^XUMF682(XFILE,"99.99^10^^^",XFIEN,99.99) ;
  1. S XFIEN=13.11
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^60^^^^D MCS13^DGZRT",XFIEN,.01)
  1. S XFIEN=13.01
  1. D SCMD5^XUMF682(XFILE,XFIEN)
  1. D SUBMD5^XUMF682(XFILE,".01^70^^^^",XFIEN,.01)
  1. Q
  1. ;