Routine: XUMF676P

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

 ;----------------------------------------------

POST ; -- Entry point

 N XUMF S XUMF=1

 D 82,83

 N X S X="XUMF676" X ^%ZOSF("DEL")

 K XMY

 ;----------------------------------------------

TEST ; -- Entry point

 N XUMF S XUMF=1

 S XMY("G.XUPATH@DOMAIN.EXT")=""

 D 82,83

 K XMY

 ;---------------------------------------------

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

XUMF676P.m