- 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
- Q
- ;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
- Q
- ; 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
- Q
- 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