Routine: BEHOARIN

BEHOARIN ;MSC/IND/DKM - ART Package KIDS Support ;22-Apr-2011 15:52;PLS

 ;;1.1;BEH COMPONENTS;**045002**;Sep 18, 2007

 ;=================================================================

 ; Environment check

EC Q

 ; Pre-init

PRE ;

 N DIU

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

 ;N IEN,REC,DFN

 S IEN=0

 F  S IEN=$O(^GMR(120.86,IEN)) Q:'IEN  S DFN=+$G(^(IEN,0)) D

 .I DFN,DFN'=IEN D

 ..M REC(DFN)=^GMR(120.86,IEN)

 ..K ^GMR(120.86,IEN),^GMR(120.86,"B",DFN,IEN)

 ..S ^GMR(120.86,"B",DFN,DFN)=""

 M:$D(REC) ^GMR(120.86)=REC

 ; Post-init

POST ;D REGMENU^BEHUTIL("BEHOAR MAIN",,"ART","BEHOMENU")

 N LP,DA

 S LP=0 F  S LP=$O(^BEHOAR(90460.06,LP)) Q:'LP  D

 .S DA=LP,DIK="^BEHOAR(90460.06," D IX^DIK

BEHOARIN  ;MSC/IND/DKM - ART Package KIDS Support ;22-Apr-2011 15:52;PLS

 +1       ;;1.1;BEH COMPONENTS;**045002**;Sep 18, 2007

 +2       ;=================================================================

 +3       ; Environment check

EC         QUIT

 +1       ; Pre-init

PRE       ;

 +1        NEW DIU

 +2        SET DIU="^BEHOAR(90460.06,"

           SET DIU(0)="D"

           DO EN^DIU2

 +3        QUIT

 +4       ;N IEN,REC,DFN

 +5        SET IEN=0

 +6        FOR

               SET IEN=$ORDER(^GMR(120.86,IEN))

               IF 'IEN

                   QUIT

               SET DFN=+$GET(^(IEN,0))

               Begin DoDot:1

 +7                IF DFN

                       IF DFN'=IEN

                           Begin DoDot:2

 +8                            MERGE REC(DFN)=^GMR(120.86,IEN)

 +9                            KILL ^GMR(120.86,IEN),^GMR(120.86,"B",DFN,IEN)

 +10                           SET ^GMR(120.86,"B",DFN,DFN)=""

                           End DoDot:2

               End DoDot:1

 +11       IF $DATA(REC)

               MERGE ^GMR(120.86)=REC

 +12       QUIT

 +13      ; Post-init

POST      ;D REGMENU^BEHUTIL("BEHOAR MAIN",,"ART","BEHOMENU")

 +1        NEW LP,DA

 +2        SET LP=0

FOR

               SET LP=$ORDER(^BEHOAR(90460.06,LP))

               IF 'LP

                   QUIT

               Begin DoDot:1

 +3                SET DA=LP

                   SET DIK="^BEHOAR(90460.06,"

                   DO IX^DIK

               End DoDot:1

 +4        QUIT

BEHOARIN.m