BOPECP01.m

BOPECP01 ;IHS/CIA/PLS - Installation Utilities;16-May-2006 09:28;SM

 ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005

ENV Q

 ;

PRE ;

 D DELDD

 Q

POST ;

 ; Remove data stored for DEFAULT PROVIDER field.

 S $P(BOP(90355,1,"SITE"),U,7)=""

 ; Register Hook Protocol

 D REGPROT("GMRA VERIFY DATA","BOP GMRA UPDATE",25)

 Q

 ; EP: Register a protocol to an extended action protocol

 ; Input: P-Parent protocol

 ;        C-Child protocol

REGPROT(P,C,S,ERR) ;

 N IENARY,PIEN,AIEN,FDA

 D

 .I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q

 .S IENARY(1)=$$FIND1^DIC(101,"","",P)

 .S AIEN=$$FIND1^DIC(101,"","",C)

 .I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q

 .S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN

 .S:$G(S) FDA(101.01,"?+2,"_IENARY(1)_",",3)=S

 .D UPDATE^DIE("S","FDA","IENARY","ERR")

 Q

 ;

 ; Display message in MSG and optionally set quit flag to QUIT

MES(MSG,QUIT) ;

 D BMES^XPDUTL("  "_$G(MSG))

 S:$G(QUIT) XPDQUIT=QUIT

 Q

DELDD ; Delete DDs

 N DIU

 F DIU=90355,90355.44 D

 .S DIU(0)=""

 .D EN^DIU2

 S DIU=90355.4,DIU(0)="D" D EN^DIU2

 Q

BOPECP01  ;IHS/CIA/PLS - Installation Utilities;16-May-2006 09:28;SM

 +1       ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005

ENV        QUIT 

 +1       ;

PRE       ;

 +1        DO DELDD

 +2        QUIT 

POST      ;

 +1       ; Remove data stored for DEFAULT PROVIDER field.

 +2        SET $PIECE(BOP(90355,1,"SITE"),U,7)=""

 +3       ; Register Hook Protocol

 +4        DO REGPROT("GMRA VERIFY DATA","BOP GMRA UPDATE",25)

 +5        QUIT 

 +6       ; EP: Register a protocol to an extended action protocol

 +7       ; Input: P-Parent protocol

 +8       ;        C-Child protocol

REGPROT(P,C,S,ERR) ;

 +1        NEW IENARY,PIEN,AIEN,FDA

 +2        Begin DoDot:1

 +3            IF '$LENGTH(P)!('$LENGTH(C))

                   SET ERR="Missing input parameter"

                   QUIT 

 +4            SET IENARY(1)=$$FIND1^DIC(101,"","",P)

 +5            SET AIEN=$$FIND1^DIC(101,"","",C)

 +6            IF 'IENARY(1)!'AIEN

                   SET ERR="Unknown protocol name"

                   QUIT 

 +7            SET FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN

 +8            IF $GET(S)

                   SET FDA(101.01,"?+2,"_IENARY(1)_",",3)=S

 +9            DO UPDATE^DIE("S","FDA","IENARY","ERR")

           End DoDot:1

 +10       QUIT 

 +11      ;

 +12      ; Display message in MSG and optionally set quit flag to QUIT

MES(MSG,QUIT) ;

 +1        DO BMES^XPDUTL("  "_$GET(MSG))

 +2        IF $GET(QUIT)

               SET XPDQUIT=QUIT

 +3        QUIT 

DELDD     ; Delete DDs

 +1        NEW DIU

 +2        FOR DIU=90355,90355.44

               Begin DoDot:1

 +3                SET DIU(0)=""

 +4                DO EN^DIU2

               End DoDot:1

 +5        SET DIU=90355.4

           SET DIU(0)="D"

           DO EN^DIU2

 +6        QUIT