XUMF479P.m

XUMF479P ;OIFO-BP/RAM - Master File Parameters Med Routes ;06/28/00

 ;;8.0;KERNEL;**479**;Jul 10, 1995;Build 19

 ;Per VHA Directive 2004-038, this routine should not be modified

 ;

 Q

 ;

MAIN ; -- Entry point

 ;

 ;Q:'$D(^DD(51.23))

 ;

 N FDA,IENS,FIELD,ERR,SEQ,XUMF,X,IEN,XMDUZ

 ;

 S XUMF=1,IEN=51.23

 ;

 D ZERO,CLEAN,NODES,MD5,EXIT

 ;

 Q

 ;

ZERO ; -- zero node

 ;

 N DIC,DA,X,DINUM,Y

 ;

 K DIC S DIC="^DIC(4.001,",X=IEN,DINUM=X,DIC(0)="F" D FILE^DICN K DIC

 ;

 K FDA

 S IENS=IEN_","

 ;

 S FDA(4.001,IENS,.01)=51.23

 S FDA(4.001,IENS,.03)="Medication Routes"

 S FDA(4.001,IENS,.07)="Medication Routes"

 S FDA(4.001,IENS,2)="D MFSUP^HDISVF09(51.23,$G(ERROR))"

 ;

 D UPDATE^DIE("","FDA",,"ERR")

 I $D(ERR) D

 .D EM("UPDATE ZERO error",.ERR)

 .K ERR

 ;

 Q

 ;

CLEAN ; -- clean out SEQUENCE

 ;

 K FDA

 S SEQ=0

 F  S SEQ=$O(^DIC(4.001,IEN,1,SEQ)) Q:'SEQ  D

 .S IENS=SEQ_","_IEN_","

 .S FDA(4.011,IENS,.01)="@"

 ;

 D FILE^DIE("E","FDA")

 ;

 Q

 ;

NODES ; -- SEQUENCE

 ;

 K FDA

 S IENS="+1,"_IEN_","

 S FDA(4.011,IENS,.01)="Term"

 S FDA(4.011,IENS,.02)=.01

 S FDA(4.011,IENS,.15)=1

 ;

 S IENS="+2,"_IEN_","

 S FDA(4.011,IENS,.01)="FDB_Med_Route"

 S FDA(4.011,IENS,.02)=1

 S FDA(4.011,IENS,.15)=2

 ;

 S IENS="+3,"_IEN_","

 S FDA(4.011,IENS,.01)="vista_replaced_by"

 S FDA(4.011,IENS,.02)=99.97

 S FDA(4.011,IENS,.15)=3

 S FDA(4.011,IENS,.13)="VUID"

 ;

 ;S IENS="+4,"_IEN_","

 ;S FDA(4.011,IENS,.01)="EffectiveDate"

 ;S FDA(4.011,IENS,.02)=.01

 ;S FDA(4.011,IENS,.04)=51.2399

 ;S FDA(4.011,IENS,.06)="EffectiveDate"

 ;S FDA(4.011,IENS,.15)=4

 ;

 S IENS="+4,"_IEN_","

 S FDA(4.011,IENS,.01)="Status"

 S FDA(4.011,IENS,.02)=.02

 S FDA(4.011,IENS,.04)=51.2399

 S FDA(4.011,IENS,.06)="Status"

 S FDA(4.011,IENS,.15)=4

 ;

 D UPDATE^DIE("E","FDA",,"ERR")

 I $D(ERR) D

 .D EM("UPDATE NODES error",.ERR)

 .K ERR

 ;

 Q

 ;

MD5 ; -- MD5

 ;

 N IENS1

 ;

 S IEN=$O(^DIC(4.005,"B","Medication Routes",0))

 ;

 I 'IEN D  Q:'IEN

 .K FDA

 .S FDA(4.005,"+1,",.01)="Medication Routes"

 .;

 .D UPDATE^DIE("E","FDA",,"ERR")

 .I $D(ERR) D

 ..D EM("UPDATE MD5 error",.ERR)

 ..K ERR

 .S IEN=$O(^DIC(4.005,"B","Medication Routes",0))

 ;

 S IENS=IEN_","

 ;

 K FDA

 S SEQ=0

 F  S SEQ=$O(^DIC(4.005,IEN,1,SEQ)) Q:'SEQ  D

 .S IENS1=SEQ_","_IEN_","

 .S FDA(4.0051,IENS1,.01)="@"

 D FILE^DIE("E","FDA","ERR")

 ;

 K FDA

 S IENS1="+1,"_IENS

 S FDA(4.0051,IENS1,.01)=51.23

 D UPDATE^DIE("E","FDA",,"ERR")

 I $D(ERR) D

 .D EM("UPDATE MD5 1 error",.ERR)

 .K ERR

 ;

 S IENS1=51.23_","_IENS

 ;

 K FDA

 S FDA(4.00511,"+1,"_IENS1,.01)=.01

 S FDA(4.00511,"+1,"_IENS1,1)=20

 S FDA(4.00511,"+2,"_IENS1,.01)=1

 S FDA(4.00511,"+2,"_IENS1,1)=30

 S FDA(4.00511,"+3,"_IENS1,.01)=99.99

 S FDA(4.00511,"+3,"_IENS1,1)=10

 S FDA(4.00511,"+4,"_IENS1,.01)=99.97

 S FDA(4.00511,"+4,"_IENS1,1)=40

 S FDA(4.00511,"+4,"_IENS1,2)="EXTERNAL"

 S FDA(4.00511,"+4,"_IENS1,3)=51.23

 ;

 D UPDATE^DIE("E","FDA",,"ERR")

 I $D(ERR) D

 .D EM("UPDATE MD5 2 error",.ERR)

 .K ERR

 ;

EXIT ; -- cleanup, and quit

 ;

 Q

 ;

EM(ERROR,ERR,XMSUB,XMY) ; -- error message

 ;

 N X,XMTEXT

 ;

 D MSG^DIALOG("AM",.X,80,,"ERR")

 ;

 S X(.1)="HL7 message ID: "_$G(HL("MID"))

 S X(.2)="",X(.3)=$G(ERROR),X(.4)=""

 S:$G(XMSUB)="" XMSUB="MFS ERROR"

 ;S XMY("G.XUMF ERROR")="",XMDUZ=.5

 S XMY("G.XUMF TEST")="",XMDUZ=.5

 S XMTEXT="X("

 ;

 D ^XMD

 ;

 Q

 ;

XUMF479P  ;OIFO-BP/RAM - Master File Parameters Med Routes ;06/28/00

 +1       ;;8.0;KERNEL;**479**;Jul 10, 1995;Build 19

 +2       ;Per VHA Directive 2004-038, this routine should not be modified

 +3       ;

 +4        QUIT 

 +5       ;

MAIN      ; -- Entry point

 +1       ;

 +2       ;Q:'$D(^DD(51.23))

 +3       ;

 +4        NEW FDA,IENS,FIELD,ERR,SEQ,XUMF,X,IEN,XMDUZ

 +5       ;

 +6        SET XUMF=1

           SET IEN=51.23

 +7       ;

 +8        DO ZERO

           DO CLEAN

           DO NODES

           DO MD5

           DO EXIT

 +9       ;

 +10       QUIT 

 +11      ;

ZERO      ; -- zero node

 +1       ;

 +2        NEW DIC,DA,X,DINUM,Y

 +3       ;

 +4        KILL DIC

           SET DIC="^DIC(4.001,"

           SET X=IEN

           SET DINUM=X

           SET DIC(0)="F"

           DO FILE^DICN

           KILL DIC

 +5       ;

 +6        KILL FDA

 +7        SET IENS=IEN_","

 +8       ;

 +9        SET FDA(4.001,IENS,.01)=51.23

 +10       SET FDA(4.001,IENS,.03)="Medication Routes"

 +11       SET FDA(4.001,IENS,.07)="Medication Routes"

 +12       SET FDA(4.001,IENS,2)="D MFSUP^HDISVF09(51.23,$G(ERROR))"

 +13      ;

 +14       DO UPDATE^DIE("","FDA",,"ERR")

 +15       IF $DATA(ERR)

               Begin DoDot:1

 +16               DO EM("UPDATE ZERO error",.ERR)

 +17               KILL ERR

               End DoDot:1

 +18      ;

 +19       QUIT 

 +20      ;

CLEAN     ; -- clean out SEQUENCE

 +1       ;

 +2        KILL FDA

 +3        SET SEQ=0

 +4        FOR 

               SET SEQ=$ORDER(^DIC(4.001,IEN,1,SEQ))

               IF 'SEQ

                   QUIT 

               Begin DoDot:1

 +5                SET IENS=SEQ_","_IEN_","

 +6                SET FDA(4.011,IENS,.01)="@"

               End DoDot:1

 +7       ;

 +8        DO FILE^DIE("E","FDA")

 +9       ;

 +10       QUIT 

 +11      ;

NODES     ; -- SEQUENCE

 +1       ;

 +2        KILL FDA

 +3        SET IENS="+1,"_IEN_","

 +4        SET FDA(4.011,IENS,.01)="Term"

 +5        SET FDA(4.011,IENS,.02)=.01

 +6        SET FDA(4.011,IENS,.15)=1

 +7       ;

 +8        SET IENS="+2,"_IEN_","

 +9        SET FDA(4.011,IENS,.01)="FDB_Med_Route"

 +10       SET FDA(4.011,IENS,.02)=1

 +11       SET FDA(4.011,IENS,.15)=2

 +12      ;

 +13       SET IENS="+3,"_IEN_","

 +14       SET FDA(4.011,IENS,.01)="vista_replaced_by"

 +15       SET FDA(4.011,IENS,.02)=99.97

 +16       SET FDA(4.011,IENS,.15)=3

 +17       SET FDA(4.011,IENS,.13)="VUID"

 +18      ;

 +19      ;S IENS="+4,"_IEN_","

 +20      ;S FDA(4.011,IENS,.01)="EffectiveDate"

 +21      ;S FDA(4.011,IENS,.02)=.01

 +22      ;S FDA(4.011,IENS,.04)=51.2399

 +23      ;S FDA(4.011,IENS,.06)="EffectiveDate"

 +24      ;S FDA(4.011,IENS,.15)=4

 +25      ;

 +26       SET IENS="+4,"_IEN_","

 +27       SET FDA(4.011,IENS,.01)="Status"

 +28       SET FDA(4.011,IENS,.02)=.02

 +29       SET FDA(4.011,IENS,.04)=51.2399

 +30       SET FDA(4.011,IENS,.06)="Status"

 +31       SET FDA(4.011,IENS,.15)=4

 +32      ;

 +33       DO UPDATE^DIE("E","FDA",,"ERR")

 +34       IF $DATA(ERR)

               Begin DoDot:1

 +35               DO EM("UPDATE NODES error",.ERR)

 +36               KILL ERR

               End DoDot:1

 +37      ;

 +38       QUIT 

 +39      ;

MD5       ; -- MD5

 +1       ;

 +2        NEW IENS1

 +3       ;

 +4        SET IEN=$ORDER(^DIC(4.005,"B","Medication Routes",0))

 +5       ;

 +6        IF 'IEN

               Begin DoDot:1

 +7                KILL FDA

 +8                SET FDA(4.005,"+1,",.01)="Medication Routes"

 +9       ;

 +10               DO UPDATE^DIE("E","FDA",,"ERR")

 +11               IF $DATA(ERR)

                       Begin DoDot:2

 +12                       DO EM("UPDATE MD5 error",.ERR)

 +13                       KILL ERR

                       End DoDot:2

 +14               SET IEN=$ORDER(^DIC(4.005,"B","Medication Routes",0))

               End DoDot:1

               IF 'IEN

                   QUIT 

 +15      ;

 +16       SET IENS=IEN_","

 +17      ;

 +18       KILL FDA

 +19       SET SEQ=0

 +20       FOR 

               SET SEQ=$ORDER(^DIC(4.005,IEN,1,SEQ))

               IF 'SEQ

                   QUIT 

               Begin DoDot:1

 +21               SET IENS1=SEQ_","_IEN_","

 +22               SET FDA(4.0051,IENS1,.01)="@"

               End DoDot:1

 +23       DO FILE^DIE("E","FDA","ERR")

 +24      ;

 +25       KILL FDA

 +26       SET IENS1="+1,"_IENS

 +27       SET FDA(4.0051,IENS1,.01)=51.23

 +28       DO UPDATE^DIE("E","FDA",,"ERR")

 +29       IF $DATA(ERR)

               Begin DoDot:1

 +30               DO EM("UPDATE MD5 1 error",.ERR)

 +31               KILL ERR

               End DoDot:1

 +32      ;

 +33       SET IENS1=51.23_","_IENS

 +34      ;

 +35       KILL FDA

 +36       SET FDA(4.00511,"+1,"_IENS1,.01)=.01

 +37       SET FDA(4.00511,"+1,"_IENS1,1)=20

 +38       SET FDA(4.00511,"+2,"_IENS1,.01)=1

 +39       SET FDA(4.00511,"+2,"_IENS1,1)=30

 +40       SET FDA(4.00511,"+3,"_IENS1,.01)=99.99

 +41       SET FDA(4.00511,"+3,"_IENS1,1)=10

 +42       SET FDA(4.00511,"+4,"_IENS1,.01)=99.97

 +43       SET FDA(4.00511,"+4,"_IENS1,1)=40

 +44       SET FDA(4.00511,"+4,"_IENS1,2)="EXTERNAL"

 +45       SET FDA(4.00511,"+4,"_IENS1,3)=51.23

 +46      ;

 +47       DO UPDATE^DIE("E","FDA",,"ERR")

 +48       IF $DATA(ERR)

               Begin DoDot:1

 +49               DO EM("UPDATE MD5 2 error",.ERR)

 +50               KILL ERR

               End DoDot:1

 +51      ;

EXIT      ; -- cleanup, and quit

 +1       ;

 +2        QUIT 

 +3       ;

EM(ERROR,ERR,XMSUB,XMY) ; -- error message

 +1       ;

 +2        NEW X,XMTEXT

 +3       ;

 +4        DO MSG^DIALOG("AM",.X,80,,"ERR")

 +5       ;

 +6        SET X(.1)="HL7 message ID: "_$GET(HL("MID"))

 +7        SET X(.2)=""

           SET X(.3)=$GET(ERROR)

           SET X(.4)=""

 +8        IF $GET(XMSUB)=""

               SET XMSUB="MFS ERROR"

 +9       ;S XMY("G.XUMF ERROR")="",XMDUZ=.5

 +10       SET XMY("G.XUMF TEST")=""

           SET XMDUZ=.5

 +11       SET XMTEXT="X("

 +12      ;

 +13       DO ^XMD

 +14      ;

 +15       QUIT 

 +16      ;