XUMF676P ;OIFO-BP/BATRAN - MFS parameters file ;02/13/2017
;;8.0;KERNEL;**676**;Jul 10, 1995;Build 8
;Per VHA Directive 10-92-142, this routine should not be modified
Q
;----------------------------------------------
POST ; -- Entry point
N XUMF S XUMF=1
D 82,83
N X S X="XUMF676" X ^%ZOSF("DEL")
K XMY
Q
;----------------------------------------------
TEST ; -- Entry point
N XUMF S XUMF=1
S XMY("G.XUPATH@DOMAIN.EXT")=""
D 82,83
K XMY
Q
;---------------------------------------------
82 ; FILE 120.82 GMR ALLERGIES
N XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
S XFIEN=120.82
S XFILE="Reactants"
S XUIEN=$O(^DIC(4.001,"B",XFIEN,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
D DEL^XUMF676(XFIEN) ; delete entry 120.82 before update
D ADD^XUMF676(XFIEN,".03;GMR Allergies].02;RDT].04;NULL].05;NULL].07;Reactants]5;D ZRT^GMRAVZRT") ; add entry
D ADD^XUMF676(XFIEN,"2;D MFSUP^HDISVF09(120.82,$G(ERROR))]4.1;99.99]4.2;vuid]4.3;ERT]4.4;.01]4.5;.01") ; add entry
D ADD^XUMF676(XFIEN,"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]6;D DFORALL^GMRAVZRT(120.82,120.822,120.8221)") ; add entry
S $P(^DIC(4.001,XFIEN,0),"^",6)=$G(XUMAIL)
D NODES^XUMF676(XFIEN,"DATA82",15) ; call ADD1 to add sub_entry
D ADD2^XUMF676(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
D DELMD5^XUMF676(XFILE)
D ADDMD5^XUMF676(XFILE,XFIEN)
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^20^^^",XFIEN,.01)
D SUBMD5^XUMF676(XFILE,"1^30^E^^",XFIEN,1)
D SUBMD5^XUMF676(XFILE,"99.99^10^^^",XFIEN,99.99)
S XFIEN=120.823
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^40^^^^",XFIEN,.01)
S XFIEN=120.822
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^45^^^^D M12082^GMRAVZRT",XFIEN,.01)
S XFIEN=120.824
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^50^E^50.416^^",XFIEN,.01)
S XFIEN=120.8205
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^60^E^50.605^^",XFIEN,.01)
;----------------------------------------------------
83 ; FILE 120.83 SIGN/SYMPTOMS
N XFIEN,XFILE,XUMAIL,XUIEN
S XFIEN=120.83
S XFILE="Reactions"
S XUIEN=$O(^DIC(4.001,"B",XFIEN,0)) ;Get existed IEN
I XUIEN>0 D
. S XUMAIL=$P($G(^DIC(4.001,XUIEN,0)),"^",6) ;get Mail Gorup pointer
. D DEL^XUMF676(XUIEN) ; delete entry
D DEL^XUMF676(XFIEN) ; delete entry 120.82 before update
D ADD^XUMF676(XFIEN,".03;Sign/Symptoms].02;RDT].04;PRE].05;POST].07;Reactions]5;D ZRT^GMRAVZRT") ; add entry
D ADD^XUMF676(XFIEN,"2;D MFSUP^HDISVF09(120.83,$G(ERROR)),TOP10^GMRAUTL2]4.1;99.99]4.2;vuid]4.3;ERT]4.4;.01]4.5;.01") ; add entry
D ADD^XUMF676(XFIEN,"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]6;D DFORALL^GMRAVZRT(120.83,120.833,120.8331)") ; add entry
S $P(^DIC(4.001,XFIEN,0),"^",6)=$G(XUMAIL)
D NODES^XUMF676(XFIEN,"DATA83",10) ; call ADD1 to add sub_entry
D ADD2^XUMF676(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
D DELMD5^XUMF676(XFILE)
D ADDMD5^XUMF676(XFILE,XFIEN)
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^20^^^",XFIEN,.01)
;D SUBMD5^XUMF676(XFILE,"1^30^^^",XFIEN,1)
D SUBMD5^XUMF676(XFILE,"99.99^10^^^",XFIEN,99.99)
S XFIEN=120.832
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^30^^^^",XFIEN,.01)
S XFIEN=120.833
D SCMD5^XUMF676(XFILE,XFIEN)
D SUBMD5^XUMF676(XFILE,".01^40^^^^D M12083^GMRAVZRT",XFIEN,.01)
;---------------------------------------------------
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUMF676P 3610 printed Dec 13, 2024@02:10:39 Page 2
XUMF676P ;OIFO-BP/BATRAN - MFS parameters file ;02/13/2017
+1 ;;8.0;KERNEL;**676**;Jul 10, 1995;Build 8
+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 82
DO 83
+3 NEW X
SET X="XUMF676"
XECUTE ^%ZOSF("DEL")
+4 KILL XMY
+5 QUIT
+6 ;----------------------------------------------
TEST ; -- Entry point
+1 NEW XUMF
SET XUMF=1
+2 SET XMY("G.XUPATH@DOMAIN.EXT")=""
+3 DO 82
DO 83
+4 KILL XMY
+5 QUIT
+6 ;---------------------------------------------
82 ; FILE 120.82 GMR ALLERGIES
+1 NEW XFIEN,XFILE,XUIENOLD,XUMAIL,XUIEN
+2 SET XFIEN=120.82
+3 SET XFILE="Reactants"
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",XFIEN,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)
End DoDot:1
+8 ; delete entry 120.82 before update
DO DEL^XUMF676(XFIEN)
+9 ; add entry
DO ADD^XUMF676(XFIEN,".03;GMR Allergies].02;RDT].04;NULL].05;NULL].07;Reactants]5;D ZRT^GMRAVZRT")
+10 ; add entry
DO ADD^XUMF676(XFIEN,"2;D MFSUP^HDISVF09(120.82,$G(ERROR))]4.1;99.99]4.2;vuid]4.3;ERT]4.4;.01]4.5;.01")
+11 ; add entry
DO ADD^XUMF676(XFIEN,"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]6;D DFORALL^GMRAVZRT(120.82,120.822,120.8221)")
+12 SET $PIECE(^DIC(4.001,XFIEN,0),"^",6)=$GET(XUMAIL)
+13 ; call ADD1 to add sub_entry
DO NODES^XUMF676(XFIEN,"DATA82",15)
+14 DO ADD2^XUMF676(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
+15 DO DELMD5^XUMF676(XFILE)
+16 DO ADDMD5^XUMF676(XFILE,XFIEN)
+17 DO SCMD5^XUMF676(XFILE,XFIEN)
+18 DO SUBMD5^XUMF676(XFILE,".01^20^^^",XFIEN,.01)
+19 DO SUBMD5^XUMF676(XFILE,"1^30^E^^",XFIEN,1)
+20 DO SUBMD5^XUMF676(XFILE,"99.99^10^^^",XFIEN,99.99)
+21 SET XFIEN=120.823
+22 DO SCMD5^XUMF676(XFILE,XFIEN)
+23 DO SUBMD5^XUMF676(XFILE,".01^40^^^^",XFIEN,.01)
+24 SET XFIEN=120.822
+25 DO SCMD5^XUMF676(XFILE,XFIEN)
+26 DO SUBMD5^XUMF676(XFILE,".01^45^^^^D M12082^GMRAVZRT",XFIEN,.01)
+27 SET XFIEN=120.824
+28 DO SCMD5^XUMF676(XFILE,XFIEN)
+29 DO SUBMD5^XUMF676(XFILE,".01^50^E^50.416^^",XFIEN,.01)
+30 SET XFIEN=120.8205
+31 DO SCMD5^XUMF676(XFILE,XFIEN)
+32 DO SUBMD5^XUMF676(XFILE,".01^60^E^50.605^^",XFIEN,.01)
+33 ;----------------------------------------------------
83 ; FILE 120.83 SIGN/SYMPTOMS
+1 NEW XFIEN,XFILE,XUMAIL,XUIEN
+2 SET XFIEN=120.83
+3 SET XFILE="Reactions"
+4 ;Get existed IEN
SET XUIEN=$ORDER(^DIC(4.001,"B",XFIEN,0))
+5 IF XUIEN>0
Begin DoDot:1
+6 ;get Mail Gorup pointer
SET XUMAIL=$PIECE($GET(^DIC(4.001,XUIEN,0)),"^",6)
+7 ; delete entry
DO DEL^XUMF676(XUIEN)
End DoDot:1
+8 ; delete entry 120.82 before update
DO DEL^XUMF676(XFIEN)
+9 ; add entry
DO ADD^XUMF676(XFIEN,".03;Sign/Symptoms].02;RDT].04;PRE].05;POST].07;Reactions]5;D ZRT^GMRAVZRT")
+10 ; add entry
DO ADD^XUMF676(XFIEN,"2;D MFSUP^HDISVF09(120.83,$G(ERROR)),TOP10^GMRAUTL2]4.1;99.99]4.2;vuid]4.3;ERT]4.4;.01]4.5;.01")
+11 ; add entry
DO ADD^XUMF676(XFIEN,"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]6;D DFORALL^GMRAVZRT(120.83,120.833,120.8331)")
+12 SET $PIECE(^DIC(4.001,XFIEN,0),"^",6)=$GET(XUMAIL)
+13 ; call ADD1 to add sub_entry
DO NODES^XUMF676(XFIEN,"DATA83",10)
+14 DO ADD2^XUMF676(XFIEN,"VistA_Mapping_Target",1,"1^VistA_Mapping_Target^.01^^")
+15 DO DELMD5^XUMF676(XFILE)
+16 DO ADDMD5^XUMF676(XFILE,XFIEN)
+17 DO SCMD5^XUMF676(XFILE,XFIEN)
+18 DO SUBMD5^XUMF676(XFILE,".01^20^^^",XFIEN,.01)
+19 ;D SUBMD5^XUMF676(XFILE,"1^30^^^",XFIEN,1)
+20 DO SUBMD5^XUMF676(XFILE,"99.99^10^^^",XFIEN,99.99)
+21 SET XFIEN=120.832
+22 DO SCMD5^XUMF676(XFILE,XFIEN)
+23 DO SUBMD5^XUMF676(XFILE,".01^30^^^^",XFIEN,.01)
+24 SET XFIEN=120.833
+25 DO SCMD5^XUMF676(XFILE,XFIEN)
+26 DO SUBMD5^XUMF676(XFILE,".01^40^^^^D M12083^GMRAVZRT",XFIEN,.01)
+27 ;---------------------------------------------------
